diff --git a/Externals.cfg b/Externals.cfg index aecac45976..8fdff0ac4b 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -8,7 +8,7 @@ required = True local_path = components/cism protocol = git repo_url = https://github.com/ESCOMP/CISM-wrapper -tag = cism2_1_69 +tag = cism2_1_78 externals = Externals_CISM.cfg required = True @@ -16,14 +16,14 @@ required = True local_path = components/rtm protocol = git repo_url = https://github.com/ESCOMP/RTM -tag = rtm1_0_73 +tag = rtm1_0_76 required = True [mosart] local_path = components/mosart protocol = git repo_url = https://github.com/ESCOMP/MOSART -tag = mosart1_0_38 +tag = mosart1_0_42 required = True [mizuRoute] @@ -37,21 +37,21 @@ required = True local_path = cime protocol = git repo_url = https://github.com/ESMCI/cime -tag = branch_tags/cime5.8.32_a02 +tag = branch_tags/cime5.8.42_a01 required = True [cmeps] local_path = cime/src/drivers/nuopc/ protocol = git repo_url = https://github.com/ESCOMP/CMEPS.git -hash = 7654038 +tag = v0.9.0 required = True [cdeps] local_path = components/cdeps protocol = git repo_url = https://github.com/ESCOMP/CDEPS.git -hash = 45b7a85 +tag = v0.6.0 required = True [doc-builder] @@ -63,4 +63,3 @@ required = False [externals_description] schema_version = 1.0.0 - diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 83128f7357..ad514c6481 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -167,6 +167,7 @@ OPTIONS (Note: buildnml copies the file for use by the driver) -glc_nec Glacier number of elevation classes [0 | 3 | 5 | 10 | 36] (default is 0) (standard option with land-ice model is 10) + -glc_use_antarctica Set defaults appropriate for runs that include Antarctica -help [or -h] Print usage to STDOUT. -light_res Resolution of lightning dataset to use for CN fire (360x720 or 94x192) -ignore_ic_date Ignore the date on the initial condition files @@ -253,6 +254,7 @@ sub process_commandline { clm_demand => "null", help => 0, glc_nec => "default", + glc_use_antarctica => 0, light_res => "default", lnd_tuning_mode => "default", lnd_frac => undef, @@ -297,6 +299,7 @@ sub process_commandline { "note!" => \$opts{'note'}, "megan!" => \$opts{'megan'}, "glc_nec=i" => \$opts{'glc_nec'}, + "glc_use_antarctica!" => \$opts{'glc_use_antarctica'}, "light_res=s" => \$opts{'light_res'}, "d:s" => \$opts{'dir'}, "h|help" => \$opts{'help'}, @@ -1102,6 +1105,12 @@ sub setup_cmdl_spinup { $nl_flags->{'bgc_spinup'} = "off"; $val = $defaults->get_value($var); } + # For AD spinup mode by default reseed dead plants + if ( $nl_flags->{$var} ne "off" ) { + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, + $defaults, $nl, "reseed_dead_plants", clm_accelerated_spinup=>$nl_flags->{$var}, + use_cn=>$nl_flags->{'use_cn'} ); + } } else { if ( defined($nl->get_value("spinup_state")) ) { $log->fatal_error("spinup_state is accelerated (=1 or 2) which is for a BGC mode of CN or BGC," . @@ -1616,6 +1625,11 @@ sub process_namelist_inline_logic { ################################## setup_logic_bgc_shared($opts, $nl_flags, $definition, $defaults, $nl, $physv); + ################################## + # namelist group: cnphenology + ################################## + setup_logic_cnphenology($opts, $nl_flags, $definition, $defaults, $nl, $physv); + ############################################# # namelist group: soilwater_movement_inparm # ############################################# @@ -1902,7 +1916,7 @@ sub setup_logic_glacier { $log->fatal_error("glc_do_dynglacier can only be set via the env variable $clm_upvar: it can NOT be set in user_nl_clm"); } - my $var = "maxpatch_glcmec"; + my $var = "maxpatch_glc"; add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, 'val'=>$nl_flags->{'glc_nec'} ); my $val = $nl->get_value($var); @@ -1917,7 +1931,8 @@ sub setup_logic_glacier { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'glc_snow_persistence_max_days'); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'albice'); - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'glacier_region_behavior'); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'glacier_region_behavior', + 'glc_use_antarctica'=>$opts->{'glc_use_antarctica'}); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'glacier_region_melt_behavior'); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'glacier_region_ice_runoff_behavior'); } @@ -2685,6 +2700,24 @@ sub setup_logic_bgc_shared { #------------------------------------------------------------------------------- +sub setup_logic_cnphenology { + my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + my @list = ( "onset_thresh_depends_on_veg", "min_crtical_dayl_depends_on_lat" ); + foreach my $var ( @list ) { + if ( &value_is_true($nl_flags->{'use_cn'}) ) { + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, $var, + 'phys'=>$physv->as_string(), 'use_cn'=>$nl_flags->{'use_cn'} ); + } else { + if ( defined($nl->get_value($var)) ) { + $log->fatal_error("$var should only be set if use_cn is on"); + } + } + } +} + +#------------------------------------------------------------------------------- + sub setup_logic_supplemental_nitrogen { # # Supplemental Nitrogen for prognostic crop cases diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index aea9c07e75..0238389a26 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -57,6 +57,10 @@ attributes from the config_cache.xml file (with keys converted to upper-case). 1 0 + +.true. +.false. + .false. @@ -442,8 +446,14 @@ attributes from the config_cache.xml file (with keys converted to upper-case). Mountain glaciers: single_at_atm_topo Greenland - inside CISM grid but outside Greenland itself: virtual Greenland itself: virtual - Antarctica: multiple --> -'single_at_atm_topo','virtual','virtual','multiple' + Antarctica: multiple + + If CISM is running over Antarctica, then we change the Antarctica + behavior to virtual. Note that the Greenland behavior is always + virtual, even if Greenland isn't included in this run. +--> +'single_at_atm_topo','virtual','virtual','multiple' +'single_at_atm_topo','virtual','virtual','virtual' -lnd/clm2/paramdata/ctsm51_params.c210112.nc -lnd/clm2/paramdata/clm50_params.c210112.nc -lnd/clm2/paramdata/clm45_params.c210112.nc +lnd/clm2/paramdata/ctsm51_params.c210305.nc +lnd/clm2/paramdata/clm50_params.c210217.nc +lnd/clm2/paramdata/clm45_params.c210217.nc @@ -549,6 +559,11 @@ attributes from the config_cache.xml file (with keys converted to upper-case). 3.d00 1.d00 + +.true. +.true. +.false. +.false. 0.5 diff --git a/bld/namelist_files/namelist_defaults_ctsm_tools.xml b/bld/namelist_files/namelist_defaults_ctsm_tools.xml index 2a14f2df50..78ab368110 100644 --- a/bld/namelist_files/namelist_defaults_ctsm_tools.xml +++ b/bld/namelist_files/namelist_defaults_ctsm_tools.xml @@ -269,7 +269,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). lnd/clm2/rawdata/mksrf_urban_0.05x0.05_simyr2000.c170724.nc +>lnd/clm2/rawdata/mksrf_urban_0.05x0.05_simyr2000.c120621.nc lnd/clm2/rawdata/mksrf_urban_0.05x0.05_zerourbanpct.c181014.nc diff --git a/bld/namelist_files/namelist_defaults_overall.xml b/bld/namelist_files/namelist_defaults_overall.xml index 5839ef7451..f0c7f3c0ff 100644 --- a/bld/namelist_files/namelist_defaults_overall.xml +++ b/bld/namelist_files/namelist_defaults_overall.xml @@ -82,18 +82,18 @@ determine default values for namelists. gx1v6 gx1v6 -gx1v6 -gx1v6 +gx1v7 +gx1v7 gx3v7 gx3v7 -USGS +gx3v7 cruncep -USGS -USGS +gx1v7 +gx1v7 gx3v7 -USGS -USGS +gx3v7 +gx3v7 T62 @@ -111,7 +111,7 @@ determine default values for namelists. test navy test -gx1v6 +gx1v7 diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 9543fbcf6f..d74989889c 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -501,7 +501,7 @@ If TRUE, irrigation will be active. If TRUE, fsat will be set to zero for crop columns. - Number of multiple elevation classes over glacier points. @@ -1096,6 +1096,18 @@ Initial seed Carbon to use at planting (only used when CN is on as well as crop) + +Phenology onset depends on the vegetation type +(only used when CN is on) + + + +The minimum critical day length for onset depends on latitude +(only used when CN is on) + + Toggle to turn on ozone stress @@ -1537,7 +1549,7 @@ If TRUE, repartition rain/snow from atmosphere based on temperature. -If TRUE, downscale longwave radiation over glc_mec landunits. +If TRUE, downscale longwave radiation over glacier landunits. This downscaling is conservative. Default: .true. @@ -2003,7 +2015,7 @@ CLM datasets exist for years: 1000 (for testing), 1850, and 2000 +"constant,1000-1002,1000-1004,850-1850,1850-1855,1850-2000,1850-2005,1850-2100,1980-2015,2000-2025,2000-2100"> 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. diff --git a/bld/namelist_files/use_cases/stdurbpt_pd.xml b/bld/namelist_files/use_cases/stdurbpt_pd.xml index ab1da63bcf..65786f32ae 100644 --- a/bld/namelist_files/use_cases/stdurbpt_pd.xml +++ b/bld/namelist_files/use_cases/stdurbpt_pd.xml @@ -10,7 +10,7 @@ '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' +'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' 'SWup','LWup','Rnet','Qh','Qle','Qstor','Qtau','Qanth','Wind','Qair','Tair','PSurf','Rainf','SWdown','LWdown','FSA','FIRA','TG','COSZEN','SoilAlpha_U','TBUILD','BUILDHEAT' diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index 56bf61a387..c12b0b211f 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -138,7 +138,7 @@ sub make_config_cache { # # Figure out number of tests that will run # -my $ntests = 1551; +my $ntests = 1552; if ( defined($opts{'compare'}) ) { $ntests += 1044; } @@ -446,6 +446,11 @@ sub make_config_cache { GLC_TWO_WAY_COUPLING=>"FALSE", phys=>"clm5_0", }, + "onset_threh w SP" =>{ options=>" -envxml_dir . -bgc sp", + namelst=>"onset_thresh_depends_on_veg=.true.", + GLC_TWO_WAY_COUPLING=>"FALSE", + phys=>"clm5_1", + }, "dribble_crphrv w/o CN" =>{ options=>" -envxml_dir . -bgc sp", namelst=>"dribble_crophrv_xsmrpool_2atm=.true.", GLC_TWO_WAY_COUPLING=>"FALSE", @@ -803,7 +808,7 @@ sub make_config_cache { phys=>"clm5_0", }, "glc_nec inconsistent" =>{ options=>"-envxml_dir .", - namelst=>"maxpatch_glcmec=5", + namelst=>"maxpatch_glc=5", GLC_TWO_WAY_COUPLING=>"FALSE", phys=>"clm5_0", }, diff --git a/cime_config/buildlib b/cime_config/buildlib index 1b32e401ed..55c47be4e9 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -133,6 +133,9 @@ def _main_func(): # to use its directories in place of stub_rof paths.append(os.path.join(lnd_root,"lilac","stub_rof")) + if (driver == 'lilac' or driver == 'nuopc'): + paths.append(os.path.join(lnd_root,"src","cpl","share_esmf")) + with open(filepath_file, "w") as filepath: filepath.write("\n".join(paths)) filepath.write("\n") diff --git a/cime_config/buildnml b/cime_config/buildnml index f60206a01d..725f636642 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -60,6 +60,7 @@ def buildnml(case, caseroot, compname): run_refdate = case.get_value("RUN_REFDATE") run_reftod = case.get_value("RUN_REFTOD") glc_nec = case.get_value("GLC_NEC") + cism_use_antarctica = case.get_value("CISM_USE_ANTARCTICA") mask = case.get_value("MASK_GRID") # ----------------------------------------------------- @@ -127,6 +128,18 @@ def buildnml(case, caseroot, compname): else: nomeg = "" + if cism_use_antarctica is None: + # This is the case for compsets without CISM, where the CISM_USE_ANTARCTICA xml + # variable isn't defined + glc_use_antarctica_flag = "" + elif isinstance(cism_use_antarctica, bool): + if cism_use_antarctica: + glc_use_antarctica_flag = "-glc_use_antarctica" + else: + glc_use_antarctica_flag = "" + else: + expect(False, "Unexpected value for CISM_USE_ANTARCTICA: {}".format(cism_use_antarctica)) + if clm_nml_use_case != "UNSET": usecase = "-use_case %s" %clm_nml_use_case else: @@ -218,12 +231,12 @@ def buildnml(case, caseroot, compname): command = ("%s -cimeroot %s -infile %s -csmdata %s -inputdata %s %s -namelist \"&clm_inparm start_ymd=%s %s/ \" " "%s %s -res %s %s -clm_start_type %s -envxml_dir %s " "-configuration %s -structure %s " - "-lnd_frac %s -glc_nec %s -co2_ppmv %s -co2_type %s -config %s " + "-lnd_frac %s -glc_nec %s %s -co2_ppmv %s -co2_type %s -config %s " "%s %s %s %s" %(cmd, _CIMEROOT, infile, din_loc_root, inputdata_file, ignore, start_ymd, clm_namelist_opts, nomeg, usecase, lnd_grid, clmusr, start_type, caseroot, configuration, structure, - lndfrac_file, glc_nec, ccsm_co2_ppmv, clm_co2_type, config_cache_file, + lndfrac_file, glc_nec, glc_use_antarctica_flag, ccsm_co2_ppmv, clm_co2_type, config_cache_file, clm_bldnml_opts, spinup, tuning, gridmask)) rc, out, err = run_cmd(command, from_dir=ctsmconf) diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 4567e755e7..8529c9443b 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -18,7 +18,7 @@ ICE = [CICE, DICE, SICE] OCN = [DOCN, ,AQUAP, SOCN] ROF = [RTM, SROF] - GLC = [CISM1, CISM2] + GLC = [CISM2, SGLC] WAV = [SWAV] BGC = optional BGC scenario @@ -501,22 +501,22 @@ I1850Clm50SpG - 1850_DATM%GSWP3v1_CLM50%SP_SICE_SOCN_MOSART_CISM2%EVOLVE_SWAV + 1850_DATM%GSWP3v1_CLM50%SP_SICE_SOCN_MOSART_CISM2%GRIS-EVOLVE_SWAV IHistClm50SpG - HIST_DATM%GSWP3v1_CLM50%SP_SICE_SOCN_MOSART_CISM2%EVOLVE_SWAV + HIST_DATM%GSWP3v1_CLM50%SP_SICE_SOCN_MOSART_CISM2%GRIS-EVOLVE_SWAV I1850Clm50BgcCropG - 1850_DATM%GSWP3v1_CLM50%BGC-CROP_SICE_SOCN_MOSART_CISM2%EVOLVE_SWAV + 1850_DATM%GSWP3v1_CLM50%BGC-CROP_SICE_SOCN_MOSART_CISM2%GRIS-EVOLVE_SWAV IHistClm50BgcCropG - HIST_DATM%GSWP3v1_CLM50%BGC-CROP_SICE_SOCN_MOSART_CISM2%EVOLVE_SWAV + HIST_DATM%GSWP3v1_CLM50%BGC-CROP_SICE_SOCN_MOSART_CISM2%GRIS-EVOLVE_SWAV - + FAIL #1117 + + + FAIL + ESCOMP/CMEPS#175 + + + + + + FAIL + ESMCI/cime#3905 + + + + + + FAIL + ESMCI/cime#3905 + + + + + + FAIL + ESMCI/cime#3915 + + + + + + FAIL + ESMCI/cime#3915 + + + + + + FAIL + #1317 + + + + + + FAIL + #1317 + + + + + + FAIL + ESMCI/cime#3496 + + + + + + FAIL + ESMCI/cime#3496 + + + diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 95db622a9c..f7f2e3391e 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -1,6 +1,6 @@ - + @@ -46,7 +46,7 @@ - + @@ -55,7 +55,7 @@ - + @@ -139,7 +139,17 @@ - + + + + + + + + + + + @@ -156,7 +166,7 @@ - + @@ -164,6 +174,15 @@ + + + + + + + + + @@ -190,15 +209,28 @@ - + + + - + + + + + + + + + @@ -206,7 +238,7 @@ - + @@ -214,7 +246,7 @@ - + @@ -247,7 +279,7 @@ - + @@ -256,7 +288,7 @@ - + @@ -265,7 +297,7 @@ - + @@ -302,7 +334,7 @@ - + @@ -331,7 +363,7 @@ - + @@ -340,7 +372,7 @@ - + @@ -348,7 +380,7 @@ - + @@ -356,7 +388,7 @@ - + @@ -381,7 +413,7 @@ - + @@ -390,7 +422,7 @@ - + @@ -407,7 +439,7 @@ - + @@ -424,7 +456,7 @@ - + @@ -453,7 +485,7 @@ - + @@ -461,7 +493,7 @@ - + @@ -470,7 +502,16 @@ - + + + + + + + + + + @@ -478,7 +519,7 @@ - + @@ -494,7 +535,7 @@ - + @@ -505,7 +546,7 @@ - + @@ -513,7 +554,7 @@ - + @@ -521,7 +562,7 @@ - + @@ -529,7 +570,7 @@ - + @@ -537,7 +578,7 @@ - + @@ -546,7 +587,7 @@ - + @@ -555,7 +596,7 @@ - + @@ -564,7 +605,7 @@ - + @@ -573,7 +614,7 @@ - + @@ -583,7 +624,17 @@ - + + + + + + + + + + + @@ -592,7 +643,7 @@ - + @@ -600,7 +651,7 @@ - + @@ -608,7 +659,7 @@ - + @@ -651,7 +702,7 @@ - + @@ -659,7 +710,7 @@ - + @@ -695,7 +746,7 @@ - + @@ -703,7 +754,7 @@ - + @@ -711,7 +762,7 @@ - + @@ -719,7 +770,7 @@ - + @@ -748,7 +799,7 @@ - + @@ -757,7 +808,7 @@ - + @@ -766,7 +817,7 @@ - + @@ -774,7 +825,7 @@ - + @@ -782,7 +833,7 @@ - + @@ -791,7 +842,7 @@ - + @@ -801,7 +852,7 @@ - + @@ -850,7 +901,7 @@ - + @@ -878,7 +929,7 @@ - + @@ -932,7 +983,7 @@ - + @@ -941,7 +992,7 @@ - + @@ -951,7 +1002,7 @@ - + @@ -959,7 +1010,7 @@ - + @@ -968,7 +1019,7 @@ - + @@ -978,7 +1029,7 @@ - + @@ -988,7 +1039,17 @@ - + + + + + + + + + + + @@ -996,7 +1057,7 @@ - + @@ -1005,16 +1066,16 @@ - + - + - + @@ -1023,7 +1084,7 @@ - + @@ -1032,7 +1093,7 @@ - + @@ -1041,7 +1102,7 @@ - + @@ -1050,7 +1111,7 @@ - + @@ -1071,7 +1132,7 @@ - + @@ -1080,7 +1141,7 @@ - + @@ -1088,7 +1149,7 @@ - + @@ -1104,7 +1165,7 @@ - + @@ -1193,7 +1254,7 @@ - + @@ -1211,7 +1272,7 @@ - + @@ -1220,7 +1281,16 @@ - + + + + + + + + + + @@ -1229,7 +1299,7 @@ - + @@ -1266,7 +1336,7 @@ - + @@ -1275,7 +1345,7 @@ - + @@ -1285,7 +1355,7 @@ - + @@ -1303,7 +1373,7 @@ - + @@ -1312,7 +1382,7 @@ - + @@ -1322,7 +1392,7 @@ - + @@ -1354,8 +1424,8 @@ - + @@ -1432,7 +1502,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1477,7 +1547,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1490,7 +1560,17 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + + + + + + + + + + + @@ -1498,7 +1578,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1508,7 +1588,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1516,7 +1596,16 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + + + + + + + + + + @@ -1527,7 +1616,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1545,7 +1634,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1554,7 +1643,17 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + + + + + + + + + + + @@ -1583,7 +1682,17 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + + + + + + + + + + + @@ -1611,7 +1720,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1653,7 +1762,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1662,7 +1771,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1670,7 +1779,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1678,7 +1787,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1705,7 +1814,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1713,7 +1822,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1721,7 +1830,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1731,7 +1840,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1740,7 +1849,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1757,7 +1866,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1776,7 +1885,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1804,7 +1913,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1813,6 +1922,15 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this + + + + + + + + + @@ -1866,7 +1984,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1884,7 +2002,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1920,6 +2038,15 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this + + + + + + + + + @@ -1928,7 +2055,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1946,7 +2073,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -1991,7 +2118,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2007,7 +2134,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2024,7 +2151,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2034,7 +2161,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2046,7 +2173,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2058,7 +2185,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2068,7 +2195,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2194,7 +2321,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2205,7 +2332,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2319,7 +2446,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2341,7 +2468,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this 2-degree since that resolution turns off Carbon isotopes - + @@ -2371,16 +2498,6 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - - - - - - - - - - @@ -2394,7 +2511,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2405,7 +2522,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + @@ -2418,7 +2535,7 @@ for ERS test as otherwise it won't work for a sub-day test (no need to run this - + diff --git a/cime_config/testdefs/testlist_clm_nuopc.xml b/cime_config/testdefs/testlist_clm_nuopc.xml deleted file mode 100644 index fe8f121f4a..0000000000 --- a/cime_config/testdefs/testlist_clm_nuopc.xml +++ /dev/null @@ -1,1911 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/cime_config/testdefs/testmods_dirs/clm/ADspinup/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/ADspinup/include_user_mods new file mode 100644 index 0000000000..fe0e18cf88 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/ADspinup/include_user_mods @@ -0,0 +1 @@ +../default diff --git a/cime_config/testdefs/testmods_dirs/clm/ADspinup/shell_commands b/cime_config/testdefs/testmods_dirs/clm/ADspinup/shell_commands new file mode 100644 index 0000000000..771777c92a --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/ADspinup/shell_commands @@ -0,0 +1,4 @@ +#!/bin/bash + +./xmlchange CLM_ACCELERATED_SPINUP="on" + diff --git a/cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode/shell_commands b/cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode/shell_commands index 19326795bb..0ed374e279 100644 --- a/cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode/shell_commands +++ b/cime_config/testdefs/testmods_dirs/clm/clm50cam6LndTuningMode/shell_commands @@ -1,4 +1,5 @@ #!/bin/bash ./xmlchange LND_TUNING_MODE="clm5_0_cam6.0" +./xmlchange ROF_NCPL='$ATM_NCPL' diff --git a/cime_config/testdefs/testmods_dirs/clm/fire_emis/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/fire_emis/user_nl_clm index 410035f89c..027b17630e 100644 --- a/cime_config/testdefs/testmods_dirs/clm/fire_emis/user_nl_clm +++ b/cime_config/testdefs/testmods_dirs/clm/fire_emis/user_nl_clm @@ -11,7 +11,7 @@ ! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases ! (includes $inst_string for multi-ensemble cases) ! Set glc_grid with CISM_GRID option -! Set maxpatch_glcmec with GLC_NEC option +! Set maxpatch_glc with GLC_NEC option !---------------------------------------------------------------------------------- hist_mfilt = 1,30 diff --git a/cime_config/testdefs/testmods_dirs/clm/pts/shell_commands b/cime_config/testdefs/testmods_dirs/clm/pts/shell_commands index ad140e45e1..1613d28b25 100644 --- a/cime_config/testdefs/testmods_dirs/clm/pts/shell_commands +++ b/cime_config/testdefs/testmods_dirs/clm/pts/shell_commands @@ -22,3 +22,5 @@ ./xmlchange NTASKS_ROF=1 ./xmlchange NTASKS_WAV=1 ./xmlchange NTASKS_ESP=1 +./xmlchange MOSART_MODE=NULL +./xmlchange RTM_MODE=NULL diff --git a/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands b/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands index e7d88b5afa..5e9068895c 100755 --- a/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands +++ b/cime_config/testdefs/testmods_dirs/clm/waccmx_offline/shell_commands @@ -1,4 +1,5 @@ ./xmlchange USE_ESMF_LIB=TRUE,ATM_NCPL=288,CALENDAR=GREGORIAN,ROF_NCPL='$ATM_NCPL',LND_TUNING_MODE="clm5_0_cam6.0" ./xmlchange CLM_BLDNML_OPTS="-megan -drydep" --append ./xmlchange RUN_STARTDATE=1979-01-01 +./xmlchange ROF_NCPL='$ATM_NCPL' diff --git a/cime_config/user_nl_clm b/cime_config/user_nl_clm index a333f1a603..47865671a2 100644 --- a/cime_config/user_nl_clm +++ b/cime_config/user_nl_clm @@ -14,7 +14,7 @@ ! (includes $inst_string for multi-ensemble cases) ! or with CLM_FORCE_COLDSTART to do a cold start ! or set it with an explicit filename here. -! Set maxpatch_glcmec with GLC_NEC option +! Set maxpatch_glc with GLC_NEC option ! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable !---------------------------------------------------------------------------------- diff --git a/cime_config/usermods_dirs/_includes/output_base/user_nl_clm b/cime_config/usermods_dirs/_includes/output_base/user_nl_clm index 15d7680c31..509e0436d3 100644 --- a/cime_config/usermods_dirs/_includes/output_base/user_nl_clm +++ b/cime_config/usermods_dirs/_includes/output_base/user_nl_clm @@ -12,7 +12,7 @@ ! 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 maxpatch_glcmec with GLC_NEC option +! Set maxpatch_glc with GLC_NEC option ! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable !---------------------------------------------------------------------------------- diff --git a/doc/ChangeLog b/doc/ChangeLog index bc681f955a..62f7b7e16e 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,1224 @@ =============================================================== +Tag name: ctsm5.1.dev035 +Originator(s): sacks (Bill Sacks) +Date: Tue Apr 20 10:45:25 MDT 2021 +One-line Summary: Misc bfb enhancements and fixes + +Purpose and description of changes +---------------------------------- + +(1) If CISM is running over Antarctica, use virtual glacier columns over + Antarctica + +(2) Remove "mec" from some glacier/ice variable names (it is misleading + to have "mec" in variable names when the ice landunit can actually + have multiple columns *or* a single column) (ESCOMP/CTSM#1294) + +(3) Add history file metadata on each variable's l2g_scale_type (adds a + landunit_mask attribute) (ESCOMP/CTSM#1343) + +(4) Use python3 in more shebang lines - needed to run python unit tests + on cheyenne + +(5) New compset naming for IG compsets (ESCOMP/CTSM#1289) + +(6) Remove calculation of fun_cost_fix that is overwritten + (ESCOMP/CTSM#1115) + +(7) Bypass grid-level water mass check when fates hydro is active + (ESCOMP/CTSM#1334) + +(8) Remove some dead code (ESCOMP/CTSM#1333) + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ +[Remove any lines that don't apply. Remove entire section if nothing applies.] + +Issues fixed (include CTSM Issue #): +- Resolves ESCOMP/CTSM#1115 (overwrite fun_cost_fix) +- Resolves ESCOMP/CTSM#1289 (After updating to cism2_1_76 or later, + change compsets involving CISM) +- Resolves ESCOMP/CTSM#1294 (Replace istice_mec with istice) +- Resolves ESCOMP/CTSM#1333 (Remove some dead code) +- Resolves ESCOMP/CTSM#1343 (Add landunit_mask (formerly l2g_scale_type) + metadata to history file) + +Notes of particular relevance for users +--------------------------------------- +[Remove any lines that don't apply. Remove entire section if nothing applies.] + +Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): +- Renamed maxpatch_glcmec to maxpatch_glc + +Substantial timing or memory changes: +- Increase in land initialization time in the PFS test + (PFS_Ld20.f09_g17.I2000Clm50BgcCrop.cheyenne_intel); this is probably + due to machine variability because I don't think any of the changes in + this tag would have any significant impact on model initialization + time. + + +Testing summary: +---------------- + + build-namelist tests (if CLMBuildNamelist.pm has changed): + + cheyenne - ok (tests pass, namelists differ as expected) + + python testing (if python code has changed; see instructions in python/README.md; document testing done): + + (any machine) - pass (ran 'make test' on cheyenne and 'make all' on my Mac) + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- ok + izumi ------- ok + +Answer changes +-------------- + +Changes answers relative to baseline: NO + +Other details +------------- + +Pull Requests that document the changes (include PR ids): +- One small piece is documented in https://github.com/ESCOMP/CTSM/pull/1334 + +=============================================================== +=============================================================== +Tag name: ctsm5.1.dev034 +Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326) +Date: Mon Apr 19 16:02:29 MDT 2021 +One-line Summary: Bring in Arctic changes to LUNA from Leah Birch + +Purpose and description of changes +---------------------------------- + +This is @lmbirch89 branch from #947 with the exception that Kattge is used in place of +Leuning in LUNA. Also the startup initial values in the luna bug fix branch #961 is +used in place of the updated values by @lmbirch89. The LUNA bug fixes have already come +in, so these are some changes to improve arctic plants. + +We have addressed the issues in phenology and photosynthesis in the high latitudes. +Development was focused on PFT specific differences and we used observations to inform +model development. GPP is improved now such that the tundra is realistically less +productive than the boreal forest. + + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[x] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): + Fixes #807 -- Revisit PFT optical properties per Majasalmi and Bright (2019) + Fixes #1307 -- Turn on reseed_dead_plants when you start AD spinup mode + +Known bugs introduced in this tag (include issue #): + #1346 -- Use of floating point flag onset_thresh is confusing in CNPhenologyMod + +Notes of particular relevance for users +--------------------------------------- + +Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): + New namelist items: onset_thresh_depends_on_veg and min_crtical_dayl_depends_on_lat + +Changes made to namelist defaults (e.g., changed parameter values): + reseed_dead_plants turned on when AD spinup mode turned on + onset_thresh_depends_on_veg and min_crtical_dayl_depends_on_lat turned on for clm5_1 physics + +Changes to the datasets (e.g., parameter, surface or initial files): + New parameter file (same as start used in PPE work) also has additional fields on it + +Notes of particular relevance for developers: +--------------------------------------------- +NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the coding style in the Developers Guide +[Remove any lines that don't apply. Remove entire section if nothing applies.] + +Caveats for developers (e.g., code that is duplicated that requires double maintenance): + As noted in #1346 some of the logic in CNPhenology in CNSeasonDecidPhenology is a bit confusing. + The soil layer used was put in CNSharedParameters and needed it's own subroutine to prevent circular dependencies. + There are new accumulator variables added that area always turned on even when not needed. Doing this + in a reasonable manner (without having lots of CNPhenology logic spilled into base types) would require + a refactoring of a better way to figure this out. + +Testing summary: regular +---------------- + + [PASS means all tests PASS; OK means tests PASS other than expected fails.] + + build-namelist tests (if CLMBuildNamelist.pm has changed): + + cheyenne - PASS + + python testing (if python code has changed; see instructions in python/README.md; document testing done): + + cheyenne - PASS + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- OK + +Answer changes +-------------- + +Changes answers relative to baseline: Yes for clm5_1 physics + + Summarize any changes to answers, i.e., + - what code configurations: clm5_1 + - 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) + oleson -- clm50_ctsm10d089_2deg_GSWP3V1_lmbirch_wkattge_jmaxb1-0.17_slatopA_1850AD + + URL for LMWG diagnostics output used to validate new climate: + http://webext.cgd.ucar.edu/I1850/clm50_ctsm10d089_2deg_GSWP3V1_lmbirch_wkattge_jmaxb1-0.17_slatopA_1850AD/ + + +Other details +------------- +Pull Requests that document the changes (include PR ids): #990 +(https://github.com/ESCOMP/ctsm/pull) + + #990 -- Arctic changes branch with Kattge in place of Leuning in LUNA + +=============================================================== +=============================================================== +Tag name: ctsm5.1.dev033 +Originator(s): mvertens (Mariana Vertenstein), sacks (Bill Sacks) +Date: Sat Apr 10 16:42:06 MDT 2021 +One-line Summary: Remove unnecessary settings of nextsw_cday + +Purpose and description of changes +---------------------------------- + +Remove setting of nextsw_cday in initialization: this hasn't been needed +ever since we stopped calculating albedos in initialization. + +Also remove nextsw_cday from clm_time_manager: this was being set but +was never referenced from here: instead, nextsw_cday was being passed as +an argument to clm_drv. + +Also, updates cime to a branch tag where I have fixed the --retry option +to create_test. + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ + +CIME Issues fixed (include issue #): +- ESMCI/cime#3912 (create_test --retry fails if the test is doing + baseline generation) + +Testing summary: +---------------- + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- OK + +Answer changes +-------------- + +Changes answers relative to baseline: NO + +Other details +------------- +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): +- cime: cime5.8.42 -> branch_tags/cime5.8.42_a01 + +Pull Requests that document the changes (include PR ids): +- Second part of https://github.com/ESCOMP/CTSM/pull/1330 + +=============================================================== +=============================================================== +Tag name: ctsm5.1.dev032 +Originator(s): mvertens (Mariana Vertenstein), sacks (Bill Sacks) +Date: Sat Apr 10 09:47:25 MDT 2021 +One-line Summary: Fix bugs in co2 from atmosphere + +Purpose and description of changes +---------------------------------- + +ctsm5.1.dev002 introduced bugs when receiving co2 from the atmosphere, +both for mct and nuopc: +- For mct, with spatially-varying co2 from atmosphere, all grid cells on + a given processor were given the co2 value from the last grid cell on + that processor +- For nuopc, co2 from atmosphere was ignored and overridden with a + constant co2 value + +This tag fixes both of those bugs. + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[X] clm5_1 + +[X] clm5_0 + +[X] ctsm5_0-nwp + +[X] clm4_5 + + +Bugs fixed or introduced +------------------------ +[Remove any lines that don't apply. Remove entire section if nothing applies.] + +Issues fixed (include CTSM Issue #): +- Resolves ESCOMP/CTSM#1327 (When using co2 from atmosphere with mct, it + looks like values are taken just from the last gridcell on each proc) + +Testing summary: +---------------- + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- OK + +Answer changes +-------------- + +Changes answers relative to baseline: YES + + Summarize any changes to answers, i.e., + - what code configurations: Cases where CTSM receives CO2 from atmosphere + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + potentially new climate + + Answer changes due to fixing these issues: + - For mct, with spatially-varying co2 from atmosphere, all grid cells on + a given processor were given the co2 value from the last grid cell on + that processor + - For nuopc, co2 from atmosphere was ignored and overridden with a + constant co2 value + + In the test suite, this leads to changes in: + - ERP_D_Ld10_P36x2_Vnuopc.f10_f10_mg37.IHistClm51BgcCrop.cheyenne_intel.clm-ciso_decStart + - ERS_Ly3_P72x2_Vnuopc.f10_f10_mg37.IHistClm50BgcCropG.cheyenne_intel.clm-cropMonthOutput + - SMS_D_Ln9_P480x1_Vnuopc.f19_g17.IHistClm50Sp.cheyenne_intel.clm-waccmx_offline + + But more widespread changes are expected - including for mct - if + coupled runs can generate spatially-varying co2 from atm + +Other details +------------- +Pull Requests that document the changes (include PR ids): +- Merges the first part of the changes in + https://github.com/ESCOMP/CTSM/pull/1330 + +=============================================================== +=============================================================== +Tag name: ctsm5.1.dev031 +Originator(s): jedwards (Jim Edwards), sacks (Bill Sacks) +Date: Sat Apr 10 07:33:49 MDT 2021 +One-line Summary: Update externals and fixes for nuopc threading + +Purpose and description of changes +---------------------------------- + +(1) Some fixes for threading with the nuopc/cmeps driver. (However, + threading with nuopc/cmeps still doesn't work completely: see + https://github.com/ESCOMP/CTSM/issues/1331.) + +(2) Updates externals to versions needed for these nuopc threading changes + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ +Known bugs introduced in this tag (include issue #): +- https://github.com/ESCOMP/CTSM/issues/1331 Some runs with NUOPC driver + with multiple threads can hang + +Notes of particular relevance for developers: +--------------------------------------------- +Changes to tests or testing: +- Temporarily changed + SMS_D_Ln9_P480x3_Vnuopc.f19_g17.IHistClm50Sp.cheyenne_intel.clm-waccmx_offline + to use a 480x1 layout so that it will pass reliably (see + https://github.com/ESCOMP/CTSM/issues/1331) + +Testing summary: +---------------- + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- OK + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: YES (but very limited) + + Summarize any changes to answers, i.e., + - what code configurations: NUOPC driver with CISM + - what platforms/compilers: cheyenne_intel; maybe others + - nature of change (roundoff; larger than roundoff/same climate; new climate): roundoff + + For an unknown reason, the new externals lead to small differences + in global sums in the CMEPS driver/mediator. For what we assume is + the same reason, lnd -> glc fields can change by roundoff (probably + due to the global renormalization). + + The only test in the aux_clm test suite where this shows up is + ERS_Ly3_P72x2_Vnuopc.f10_f10_mg37.IHistClm50BgcCropG.cheyenne_intel.clm-cropMonthOutput + + If bitwise differences were observed, how did you show they were no worse + than roundoff? + + Inspection of cpl hist files + +Other details +------------- +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): +- cism: cism2_1_75 -> cism_1_78 +- rtm: rtm1_0_75 -> rtm1_0_76 +- mosart: mosart1_0_41 -> mosart1_0_42 +- cime: cime5.8.39 -> cime5.8.42 +- cmeps: v0.5.0 -> v0.9.0 +- cdeps: v0.5.0 -> v0.6.0 + +Pull Requests that document the changes (include PR ids): +- https://github.com/ESCOMP/CTSM/pull/1319 + +=============================================================== +=============================================================== +Tag name: ctsm5.1.dev030 +Originator(s): mvertens / erik (Erik Kluzek,UCAR/TSS,303-497-1326) +Date: Wed Mar 31 16:46:04 MDT 2021 +One-line Summary: New single column functionality for the NUOPC cap + +Purpose and description of changes +---------------------------------- + +Implemented new nuopc/cmeps single column functionality. + +In config/cesm/config_files.xml - single point domains are only used +for mct/cpl7. For cmeps single point meshes are now generated on the +fly and component domains files are no longer needed. +env_run.xml variables PTS_LAT, PTS_LON and PTS_DOMAINFILE are used +to determine if there is a single point or single column run. +If PTS_LAT and PTS_LON are not -999 and PTS_DOMAINFILE is UNSET, +then you have a single point run and the exact values of PTS_LAT +and PTS_LON are used. If PTS_LAT and PTS_LON are not -999 and +PTS_DOMAINFILE is not UNSET, then then the cmeps driver will recognize the nearest neighbor +values of PTS_LAT and PTS_LON in PTS_DOMAINFILE as the single column lat and lon to use. + + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): + Fixes #1312 -- Add NUOPC tests + Fixes #1302 -- Setup to allow landuse.timeseries file for high resolution cases for 2000-2025 + Fixes #1183 -- mkmapdata needs input option for large file support, current defaults unsuitable for high res grids. + +Known bugs introduced in this tag (include issue #): + +Known bugs found since the previous tag (include issue #): + #1317 -- MPI timeout for some izumi_nag tests reading in datm forcing files in NUOPC cap + #1314 -- Send unset value for scol_lat/lon from driver + +Notes of particular relevance for users +--------------------------------------- + +Notes of particular relevance for developers: +--------------------------------------------- +NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the coding style in the Developers Guide +[Remove any lines that don't apply. Remove entire section if nothing applies.] + +Caveats for developers (e.g., code that is duplicated that requires double maintenance): + Nine step tests changed so that they have ROF run at same frequency as ATM (like the similar CAM tests) + as these will fail with NUOPC since it doesn't allow you to end not on an even time-step for all components. + One of these tests changed to a CAM type test from decStart + +Changes to tests or testing: Add more NUOPC tests to test list + + +Testing summary: regular +---------------- + [PASS means all tests PASS; OK means tests PASS other than expected fails.] + + build-namelist tests (if CLMBuildNamelist.pm has changed): + + cheyenne - PASS + + tools-tests (test/tools) (if tools have been changed): + + cheyenne - OK + + python testing (if python code has changed; see instructions in python/README.md; document testing done): + + cheyenne -- FAIL + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- OK + + any other testing (give details below): Ran full izumi test list for nuopc driver (failed tests appear above) + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: No + (List of fields change though) + + +Other details +------------- + +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): cime, CDEPS, CMEPS + cime to cime5.8.39 + CDEPS to v0.5.0 + CMEPS to v0.5.0 + +Pull Requests that document the changes (include PR ids): +(https://github.com/ESCOMP/ctsm/pull) + #1309 -- New single column functionality for NUOPC/CMEPS + #1310 -- run_sys_tests: add --retry option on izumi + +=============================================================== +=============================================================== +Tag name: ctsm5.1.dev029 +Originator(s): mvertens (Mariana Vertenstein), sacks (Bill Sacks) +Date: Thu Mar 18 21:21:21 MDT 2021 +One-line Summary: Rework domain initialization for nuopc + +Purpose and description of changes +---------------------------------- + +Total rework of land domain initialization - no longer need domain files +to be created with NUOPC cap. + +Also, significant performance improvements with the NUOPC cap. + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Notes of particular relevance for developers: +--------------------------------------------- + +Caveats for developers (e.g., code that is duplicated that requires double maintenance): +- We still need to figure out how to apply this to LILAC: for now, LILAC + is still using the old method (as is MCT): reading domain information + from fatmlndfrac + + +Testing summary: +---------------- + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- PASS + +Answer changes +-------------- + +Changes answers relative to baseline: YES, but just for NUOPC and +limited changes for LILAC + + Summarize any changes to answers, i.e., + - what code configurations: NUOPC, and limited changes for LILAC + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + roundoff + + For nuopc: changes in area (relatively large differences in the + f10 test in the test suite, but Mariana saw only very small + changes in an f09 case), landfrac; these influence l2r fields, + which in turn influence TWS and methane fields. + + For lilac: just changes in area + + If bitwise differences were observed, how did you show they were no worse + than roundoff? Examination of cprnc diffs. + +Other details +------------- + +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): +- rtm: rtm1_0_74 -> rtm1_0_75 +- mosart: branch_tag/pio2.n01_mosart1_0_38 -> mosart1_0_41 + +Pull Requests that document the changes (include PR ids): +- https://github.com/ESCOMP/CTSM/pull/1258 +- https://github.com/ESCOMP/CTSM/pull/1236 (closed and replaced by 1258) + +=============================================================== +=============================================================== +Tag name: ctsm5.1.dev028 +Originator(s): swensosc (Sean Swenson) +Date: Wed Mar 17 20:08:51 MDT 2021 +One-line Summary: Change limitation of top layer evaporation/sublimation + +Purpose and description of changes +---------------------------------- + +Sublimation from top soil layer and evaporation/sublimation from top +snow layer needs to be limited to ensure moisture states do not become +negative. The original formulation did not always work, so we added a +new limitation to SoilFluxesMod. + +Also removes a limitation in SoilHydrologyMod that seemed not to +conserve energy and should no longer be necessary with the reworked +limitation in SoilFluxesMod. + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): +- Resolves ESCOMP/CTSM#1253 (h2osoi_ice can go significantly negative) + + +Notes of particular relevance for users +--------------------------------------- + +Caveats for users (e.g., need to interpolate initial conditions): +- The old flux limitation in SoilHydrologyMod has been replaced by a + truncation of roundoff-level values followed by a check that the final + state is non-negative. Although this check hasn't been triggered in + any of our testing, it's possible that we'll run into situations where + we need to relax the tolerance for this check. + +Testing summary: +---------------- + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- OK + +Answer changes +-------------- + +Changes answers relative to baseline: YES + + 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): + Not investigated carefully, 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 + + +Other details +------------- + +Pull Requests that document the changes (include PR ids): +https://github.com/ESCOMP/CTSM/pull/1282 + +=============================================================== +=============================================================== +Tag name: ctsm5.1.dev027 +Originator(s): sacks (Bill Sacks) +Date: Mon Mar 15 14:05:20 MDT 2021 +One-line Summary: Update cime and other externals; includes switch to pio2 + +Purpose and description of changes +---------------------------------- + +Updates cime and other externals to version in cesm2_3_alpha02b (with +some minor changes to cime on top of that). This includes substantial +changes to cime, including switching to PIO2 rather than PIO1. + +Also: + +- For LILAC, changes default pio_rearranger now that we're using PIO2 by + default + +- In run_sys_tests, adds '-k oed' to qsub command on cheyenne; this is + useful now that qpeek is disabled on cheyenne (this puts the job's + stdout and stderr files directly in their final location from the + beginning, rather than keeping them in some temporary location on the + compute node until the job completes) + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): +- Resolves ESCOMP/CTSM#1175 (Once there is a cime tag with pio2 as the + default, update to it) +- Resolves ESCOMP/CTSM#1194 (Once we switch to pio2 by default, change + the default rearranger used in LILAC) + +Notes of particular relevance for users +--------------------------------------- + +Caveats for users (e.g., need to interpolate initial conditions): +- PIO2 is now the default. This has been tested extensively, but let us + know if you run into any I/O related issues. Also, from testing we've + done, I/O performance looks better than with PIO1 in many cases, but + also let us know if you see a substantial degradation in I/O + performance. + +Changes made to namelist defaults (e.g., changed parameter values): +- Some I/O-related defaults change with the use of PIO2 rather than PIO1 + +Substantial timing or memory changes: +- Various changes due to the change to PIO2, some of them large. For the + most part, timing improves with PIO2, particularly for production + resolutions. +- The PFS test and many others show a substantial improvement in timing. + This is especially noticeable in initialization time. For example, the + initialization time of + PFS_Ld20.f09_g17.I2000Clm50BgcCrop.cheyenne_intel dropped from 111 sec + to 34 sec. (These tests were run a couple of weeks apart, before and + after a cheyenne upgrade, so there may be some machine variability in + these numbers, but I saw a big improvement a few months ago with a + more objective comparison.) + +Testing summary: +---------------- + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- ok + izumi ------- pass + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: YES, but just for nuopc + + Summarize any changes to answers, i.e., + - what code configurations: Just with nuopc driver + - what platforms/compilers: all + - nature of change (roundoff; larger than roundoff/same climate; new climate): + Not investigated + + The only test that changes answers is + SMS_D_Ld5_Vnuopc.f10_f10_mg37.I2000Clm50BgcCrop.cheyenne_intel.clm-default + + (There are NLCOMP failures in all tests, though, due to the update to pio2.) + +Other details +------------- +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): +- CISM: cism2_1_69 -> cism2_1_75 +- RTM: rtm1_0_73 -> rtm1_0_74 +- MOSART: mosart1_0_38 -> branch_tag/pio2.n01_mosart1_0_38 +- CIME: branch_tags/cime5.8.32_a02 -> branch_tags/cime5.8.37_a02 +- CMEPS: 7654038 -> c4acaa8 +- CDEPS: 45b7a85 -> 1f02a73 + +=============================================================== +=============================================================== +Tag name: ctsm5.1.dev026 +Originator(s): sacks (Bill Sacks) +Date: Mon Mar 8 13:20:33 MST 2021 +One-line Summary: Change f10 tests to use mg37 mask + +Purpose and description of changes +---------------------------------- + +The musgs mask will soon be dropped, and has already been dropped for +nuopc + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Notes of particular relevance for developers: +--------------------------------------------- +Changes to tests or testing: All f10_f10_musgs tests changed to f10_f10_mg37 + + +Testing summary: +---------------- + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- pass + izumi ------- pass + +Answer changes +-------------- + +Changes answers relative to baseline: NO + + BFAIL results for all f10 tests because the tests have changed, but + no answer changes + +=============================================================== +=============================================================== +Tag name: ctsm5.1.dev025 +Originator(s): sacks (Bill Sacks) +Date: Tue Feb 23 11:20:17 MST 2021 +One-line Summary: Refactor ozone code, and misc. small fixes + +Purpose and description of changes +---------------------------------- + +(1) Restructure ozone code (https://github.com/ESCOMP/CTSM/pull/1276) in + preparation for new ozone parameterization. + +(2) Fix non-standard hexadecimal constant + (https://github.com/ESCOMP/CTSM/pull/1271), needed for gfortran 10 + +(3) Remove support for CISM1 (https://github.com/ESCOMP/CTSM/pull/1226) + +(4) Move final WaterGridcellBalance call out to clm_driver (resolves + ESCOMP/CTSM#1286) + +(5) Only add WA and QCHARGE history fields if use_aquifer_layer is true + (resolves ESCOMP/CTSM#1281) + +(6) Consolidate conditional structures for VIC initialization (resolves + ESCOMP/CTSM#1287) + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): +- Resolves ESCOMP/CTSM#1286 (Move call to WaterGridcellBalance out to + the driver) +- Resolves ESCOMP/CTSM#1281 (Remove deprecated history output) +- Resolves ESCOMP/CTSM#1287 (Inconsistent logic for VIC initialization + can cause crash in debug mode) +- Resolves ESCOMP/CTSM#1270 (Hexadecimal constants use non-standard + Fortran) + + +Testing summary: +---------------- + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- OK + izumi ------- OK + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: NO + + Field lists differ for Clm50 / Clm51 / Ctsm50 tests; otherwise + bit-for-bit + +Other details +------------- +Pull Requests that document the changes (include PR ids): +- https://github.com/ESCOMP/CTSM/pull/1276 (Restructure ozone code) +- https://github.com/ESCOMP/CTSM/pull/1271 (Fix non-standard hexadecimal constant) +- https://github.com/ESCOMP/CTSM/pull/1226 (Remove support for CISM1) + +=============================================================== +=============================================================== +Tag name: ctsm5.1.dev024 +Originator(s): slevis (Samuel Levis,303-665-1310) +Date: Sat Feb 20 14:42:33 MST 2021 +One-line Summary: Grid cell-level error check for H2O + +Purpose of changes +------------------ + + For more robust mass balance error checking, introduced + grid cell-level error check for H2O following the approach + of pull requests #984 and #1022 + + +Bugs fixed or introduced +------------------------ + +Issues fixed (include CTSM Issue #): #201 + + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + +Notes of particular relevance for users +--------------------------------------- + +Caveats for users (e.g., need to interpolate initial conditions): + None + +Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): + None + +Changes made to namelist defaults (e.g., changed parameter values): + None + +Changes to the datasets (e.g., parameter, surface or initial files): + None + +Substantial timing or memory changes: [For timing changes, can check PFS test(s) in the test suite] + None + +Notes of particular relevance for developers: (including Code reviews and testing) +--------------------------------------------- +NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the coding style in the Developers Guide + +Caveats for developers (e.g., code that is duplicated that requires double maintenance): + None + +Changes to tests or testing: + None + +CTSM testing: + + [PASS means all tests PASS and OK means tests PASS other than expected fails.] + + build-namelist tests: + + cheyenne - + + tools-tests (test/tools): + + cheyenne - + + PTCLM testing (tools/shared/PTCLM/test): + + cheyenne - + + python testing (see instructions in python/README.md; document testing done): + + (any machine) - + + regular tests (aux_clm): + + cheyenne ---- OK (comparisons to baseline fail as expected) + izumi ------- OK (comparisons to baseline fail as expected) + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: YES + + Summarize any changes to answers, i.e., + - what code configurations: ALL + - what platforms/compilers: ALL + - nature of change: ROUNDOFF + + Explanation: Moving call BalanceCheck to after the call lnd2glc in + subroutine clm_drv causes a change in order of operations that leads to + roundoff change in ERRH2O. Confirmed by running ./summarize_cprnc_diffs + + +Detailed list of changes +------------------------ + +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): + None + +Pull Requests that document the changes (include PR ids): + https://github.com/ESCOMP/ctsm/pull/1228 + +=============================================================== +=============================================================== +Tag name: ctsm5.1.dev023 +Originator(s): erik (Erik Kluzek,UCAR/TSS,303-497-1326) +Date: Thu Feb 11 00:14:03 MST 2021 +One-line Summary: Calculate leaf biomass for non-woody PFTS, and a few other small answer changes + +Purpose and description of changes +---------------------------------- + +Replace hard code constant 0.25 for leaf mass per area with calculation based on parameter slatop (specific leaf area, top of +canopy). Also move num_iter into loop over patches; currently it sits outside a loop, so p index is incorrect. + +Also do some small answer changes in terms of new parameter files, and some other existing issues that have mild answer changes. + + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[X] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ +Issues fixed (include CTSM Issue #): + Fixes #1256 -- num_iter incorrect + Fixes #1268 -- Leaf biomass not updated for + Fixes #1262 -- pconv should be 1 for crops + Fixes #1261 -- Restarts fail in AD-spinup mode + Fixes #1255 -- mkmapdata crashes because of modules + Fixes #1252 -- New urban dataset for fsurdat fails when used with new model + Fixes #1184 -- slatop for generic crop + Fixes #932 --- Diagnostic variables are incorrect + Fixes #478 --- Bare soil g1 should be zero + +Known bugs found since the previous tag (include issue #): + #1274 -- Dead PFTs in PPE2_BHSon simulations + + +Notes of particular relevance for users +--------------------------------------- + +Changes made to namelist defaults (e.g., changed parameter values): + Parameter files are updated + +Changes to the datasets (e.g., parameter, surface or initial files): + +Notes of particular relevance for developers: +--------------------------------------------- +NOTE: Be sure to review the steps in README.CHECKLIST.master_tags as well as the coding style in the Developers Guide + +Caveats for developers (e.g., code that is duplicated that requires double maintenance): + Leaf biomass should still be completely moved outside of CanopyFluxes + +Changes to tests or testing: Add ADspinup test + Add an ADspinup restart test that would've detected one of the bugs fixed here + + +Testing summary: regular tools +---------------- + + [PASS means all tests PASS; OK means tests PASS other than expected fails.] + + build-namelist tests (if CLMBuildNamelist.pm has changed): + + cheyenne - PASS (348 tests are different because of parameter file update) + + tools-tests (test/tools) (if tools have been changed): + + cheyenne - PASS + + python testing (if python code has changed; see instructions in python/README.md; document testing done): + + cheyenne - PASS + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- PASS + izumi ------- PASS + + any other testing (give details below): + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: Yes, clm51, clm50-non-crop, clm45 two diagnostics + + Summarize any changes to answers, i.e., + - what code configurations: clm5_1 for all, clm50 for non-crop (Sp and Bgc), clm4_5 two diagnostics + - what platforms/compilers: All + - nature of change: clm51--BGC climate, others similar climate + +Other details +------------- +Pull Requests that document the changes (include PR ids): +(https://github.com/ESCOMP/ctsm/pull) + + #1254 -- replace constant leaf mass per area (lma) + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev022 Originator(s): gregorylemieux (Gregory Lemieux,LBL/NGEET,510-486-5049) Date: Fri Feb 5 00:03:28 MST 2021 diff --git a/doc/ChangeSum b/doc/ChangeSum index ffd5a805a4..1816a557a9 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,18 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev035 sacks 04/20/2021 Misc bfb enhancements and fixes + ctsm5.1.dev034 erik 04/19/2021 Bring in Arctic changes to LUNA from Leah Birch + ctsm5.1.dev033 mvertens 04/10/2021 Remove unnecessary settings of nextsw_cday + ctsm5.1.dev032 mvertens 04/10/2021 Fix bugs in co2 from atmosphere + ctsm5.1.dev031 jedwards 04/10/2021 Update externals and fixes for nuopc threading + ctsm5.1.dev030 erik 03/31/2021 New single column functionality for the NUOPC cap + ctsm5.1.dev029 mvertens 03/18/2021 Rework domain initialization for nuopc + ctsm5.1.dev028 swensosc 03/17/2021 Change limitation of top layer evaporation/sublimation + ctsm5.1.dev027 sacks 03/15/2021 Update cime and other externals; includes switch to pio2 + ctsm5.1.dev026 sacks 03/08/2021 Change f10 tests to use mg37 mask + ctsm5.1.dev025 sacks 02/23/2021 Refactor ozone code, and misc. small fixes + ctsm5.1.dev024 slevis 02/20/2021 Grid cell-level error check for H2O + ctsm5.1.dev023 erik 02/11/2021 Calculate leaf biomass for non-woody PFTS, and a few other small answer changes ctsm5.1.dev022 glemieux 02/05/2021 Merge fates_main_api into ctsm master ctsm5.1.dev021 erik 01/12/2021 Add option for biomass heat storage (BHS) to clm5_1 physics ctsm5.1.dev020 erik 12/30/2020 Potential roundoff changes in preparation for bio-mass heat storage option diff --git a/doc/source/lilac/specific-atm-models/wrf.rst b/doc/source/lilac/specific-atm-models/wrf.rst index f1118973e9..d34dd66d0b 100644 --- a/doc/source/lilac/specific-atm-models/wrf.rst +++ b/doc/source/lilac/specific-atm-models/wrf.rst @@ -322,10 +322,18 @@ The following is the recommended CTSM options to run WRF:: In ``ctsm.cfg`` you should specify CTSM domain file, surface dataset and finidat file. For this example (US domain), you can use the following settings:: - lnd_domain_file = /glade/work/slevis/barlage_wrf_ctsm/conus/gen_domain_files/domain.lnd.wrf2ctsm_lnd_wrf2ctsm_ocn.191211.nc - fsurdat = /glade/work/slevis/git_wrf/ctsm_surf/surfdata_conus_hist_16pfts_Irrig_CMIP6_simyr2000_c191212.nc + lnd_domain_file = /glade/work/slevis/git_wrf/ctsm_domain/domain.lnd.wrf2clm_lnd_noneg_wrf2clm_ocn_noneg.201117.nc + fsurdat = /glade/work/slevis/git_wrf/ctsm_surf/surfdata_conus_hist_16pfts_Irrig_CMIP6_simyr2000_c210119.nc finidat = /glade/work/slevis/git_wrf/ctsm_init/finidat_interp_dest_wrfinit_snow_ERAI_12month.nc +File ``user_nl_ctsm`` allows you to override individual CTSM namelist variables +and set any extra namelist items you would like to appear in your ``lnd_in``. +For this example, we recommend adding the following options in +``user_nl_ctsm``:: + + use_init_interp = .true. + init_interp_fill_missing_with_natveg = .true. + Run the script ``make_runtime_inputs`` to create ``lnd_in`` and ``clm.input_data_list``:: @@ -333,8 +341,8 @@ Run the script ``make_runtime_inputs`` to create ``lnd_in`` and Modify ``lilac_in`` as needed. For this example, you can use the following options:: - atm_mesh_filename = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' - lnd_mesh_filename = '/glade/work/slevis/barlage_wrf_ctsm/conus/mesh/wrf2ctsm_land_conus_ESMFMesh_c20191216.nc' + atm_mesh_filename = '/glade/scratch/negins/wrf_ctsm_files/wrf2ctsm_land_conus_ESMFMesh_c20201110.nc' + lnd_mesh_filename = '/glade/scratch/negins/wrf_ctsm_files/wrf2ctsm_land_conus_ESMFMesh_c20201110.nc' Run ``download_input_data`` script to download any of CTSM's standard input diff --git a/doc/source/users_guide/setting-up-and-running-a-case/customizing-the-clm-configuration.rst b/doc/source/users_guide/setting-up-and-running-a-case/customizing-the-clm-configuration.rst index f752b1a766..08041c522a 100644 --- a/doc/source/users_guide/setting-up-and-running-a-case/customizing-the-clm-configuration.rst +++ b/doc/source/users_guide/setting-up-and-running-a-case/customizing-the-clm-configuration.rst @@ -405,7 +405,7 @@ Example: user_nl_clm namelist file ! (includes $inst_string for multi-ensemble cases) ! Set glc_grid with GLC_GRID option ! Set glc_smb with GLC_SMB option - ! Set maxpatch_glcmec with GLC_NEC option + ! Set maxpatch_glc with GLC_NEC option !---------------------------------------------------------------------------------- hist_fincl2 = 'TG','TBOT','FIRE','FIRA','FLDS','FSDS', 'FSR','FSA','FGEV','FSH','FGR','TSOI', diff --git a/doc/source/users_guide/setting-up-and-running-a-case/customizing-the-clm-namelist.rst b/doc/source/users_guide/setting-up-and-running-a-case/customizing-the-clm-namelist.rst index 2712c70ae7..70795acda7 100644 --- a/doc/source/users_guide/setting-up-and-running-a-case/customizing-the-clm-namelist.rst +++ b/doc/source/users_guide/setting-up-and-running-a-case/customizing-the-clm-namelist.rst @@ -73,7 +73,7 @@ Example 1-2. Default CLM Namelist fsnowaging = '/glade/p/cesm/cseg/inputdata/lnd/clm2/snicardata/snicar_drdt_bst_fit_60_c070416.nc' fsnowoptics = '/glade/p/cesm/cseg/inputdata/lnd/clm2/snicardata/snicar_optics_5bnd_c090915.nc' fsurdat = '/glade/p/cesm/cseg/inputdata/lnd/clm2/surfdata_map/surfdata_0.9x1.25_simyr1850_c130415.nc' - maxpatch_glcmec = 0 + maxpatch_glc = 0 more_vertlayers = .false. nsegspc = 20 spinup_state = 0 diff --git a/lilac/bld_templates/lnd_modelio_template.nml b/lilac/bld_templates/lnd_modelio_template.nml index 6ee97fb119..8686ebeeca 100644 --- a/lilac/bld_templates/lnd_modelio_template.nml +++ b/lilac/bld_templates/lnd_modelio_template.nml @@ -1,7 +1,7 @@ &pio_inparm pio_netcdf_format = "64bit_offset" pio_numiotasks = -99 - pio_rearranger = 1 + pio_rearranger = $PIO_REARRANGER pio_root = 1 pio_stride = $PIO_STRIDE pio_typename = "$PIO_TYPENAME" diff --git a/python/Makefile b/python/Makefile index 470d32b9d4..6c7e1ab32c 100644 --- a/python/Makefile +++ b/python/Makefile @@ -8,7 +8,7 @@ debug = not-set ifneq ($(python), not-set) PYTHON=$(python) else - PYTHON=python + PYTHON=python3 endif ifneq ($(debug), not-set) diff --git a/python/README.md b/python/README.md index c1cd00e4aa..57a3179bac 100644 --- a/python/README.md +++ b/python/README.md @@ -14,7 +14,7 @@ thing, but support different options: You can specify a few arguments to this: - - python version: `make python=python3 test` + - python version: `make python=python3.9 test` (defaults to `python3`; you should expect errors if trying to run with python2) - verbose: `make verbose=true test` - debug: `make debug=true test` diff --git a/python/ctsm/lilac_build_ctsm.py b/python/ctsm/lilac_build_ctsm.py index 4774993e7e..888008897a 100644 --- a/python/ctsm/lilac_build_ctsm.py +++ b/python/ctsm/lilac_build_ctsm.py @@ -23,7 +23,7 @@ # these are arbitrary, since we only use the case for its build, not any of the runtime # settings; they just need to be valid _COMPSET = 'I2000Ctsm50NwpSpAsRs' -_RES = 'f10_f10_musgs' +_RES = 'f10_f10_mg37' _PATH_TO_TEMPLATES = os.path.join(path_to_ctsm_root(), 'lilac', @@ -473,8 +473,8 @@ def _check_and_transform_os(os_type): 'cnl': 'CNL'} try: os_type_transformed = transforms[os_type] - except KeyError: - raise ValueError("Unknown OS: {}".format(os_type)) + except KeyError as exc: + raise ValueError("Unknown OS: {}".format(os_type)) from exc return os_type_transformed def _get_case_dir(build_dir): @@ -658,12 +658,18 @@ def _stage_runtime_inputs(build_dir, no_pnetcdf): pio_stride = _xmlquery('MAX_MPITASKS_PER_NODE', build_dir) if no_pnetcdf: pio_typename = 'netcdf' + # pio_rearranger = 1 is generally more efficient with netcdf (see + # https://github.com/ESMCI/cime/pull/3732#discussion_r508954806 and the following + # discussion) + pio_rearranger = 1 else: pio_typename = 'pnetcdf' + pio_rearranger = 2 fill_template_file( path_to_template=os.path.join(_PATH_TO_TEMPLATES, 'lnd_modelio_template.nml'), path_to_final=os.path.join(build_dir, _RUNTIME_INPUTS_DIRNAME, 'lnd_modelio.nml'), - substitutions={'PIO_STRIDE':pio_stride, + substitutions={'PIO_REARRANGER':pio_rearranger, + 'PIO_STRIDE':pio_stride, 'PIO_TYPENAME':pio_typename}) shutil.copyfile( diff --git a/python/ctsm/lilac_download_input_data.py b/python/ctsm/lilac_download_input_data.py index 1e0c240d25..dffc78150a 100644 --- a/python/ctsm/lilac_download_input_data.py +++ b/python/ctsm/lilac_download_input_data.py @@ -5,10 +5,10 @@ import os import re -from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args - from CIME.case import Case # pylint: disable=import-error +from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args + logger = logging.getLogger(__name__) # ======================================================================== diff --git a/python/ctsm/lilac_make_runtime_inputs.py b/python/ctsm/lilac_make_runtime_inputs.py index 5b9a4e1f76..2119c0e225 100644 --- a/python/ctsm/lilac_make_runtime_inputs.py +++ b/python/ctsm/lilac_make_runtime_inputs.py @@ -8,12 +8,12 @@ from configparser import ConfigParser from configparser import NoSectionError, NoOptionError +from CIME.buildnml import create_namelist_infile # pylint: disable=import-error + from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args from ctsm.path_utils import path_to_ctsm_root from ctsm.utils import abort -from CIME.buildnml import create_namelist_infile # pylint: disable=import-error - logger = logging.getLogger(__name__) # ======================================================================== diff --git a/python/ctsm/machine.py b/python/ctsm/machine.py index 6065f54716..36e5c61788 100644 --- a/python/ctsm/machine.py +++ b/python/ctsm/machine.py @@ -3,9 +3,9 @@ import logging from collections import namedtuple +from CIME.utils import get_project # pylint: disable=import-error from ctsm.joblauncher.job_launcher_factory import \ create_job_launcher, JOB_LAUNCHER_NOBATCH -from CIME.utils import get_project # pylint: disable=import-error logger = logging.getLogger(__name__) @@ -23,11 +23,12 @@ # user of the machine object to check for that possibility if need be. # # Similar notes apply to baseline_dir. -Machine = namedtuple('Machine', ['name', # str - 'scratch_dir', # str - 'baseline_dir', # str - 'account', # str or None - 'job_launcher']) # subclass of JobLauncherBase +Machine = namedtuple('Machine', ['name', # str + 'scratch_dir', # str + 'baseline_dir', # str + 'account', # str or None + 'create_test_retry', # int + 'job_launcher']) # subclass of JobLauncherBase def create_machine(machine_name, defaults, job_launcher_type=None, scratch_dir=None, account=None, @@ -78,6 +79,7 @@ def create_machine(machine_name, defaults, job_launcher_type=None, mach_defaults = defaults.get(machine_name) baseline_dir = None + create_test_retry = 0 if mach_defaults is not None: if job_launcher_type is None: job_launcher_type = mach_defaults.job_launcher_type @@ -93,6 +95,10 @@ def create_machine(machine_name, defaults, job_launcher_type=None, # generation and comparison, or making a link in some temporary location that # points to the standard baselines). baseline_dir = mach_defaults.baseline_dir + # We also don't provide a way to override the default create_test_retry in the + # machine object: this will always give the default value for this machine, and + # other mechanisms will be given for overriding this in a particular case. + create_test_retry = mach_defaults.create_test_retry if account is None and mach_defaults.account_required and not allow_missing_entries: raise RuntimeError("Could not find an account code") else: @@ -142,21 +148,23 @@ def create_machine(machine_name, defaults, job_launcher_type=None, scratch_dir=scratch_dir, baseline_dir=baseline_dir, account=account, + create_test_retry=create_test_retry, job_launcher=job_launcher) -def get_possibly_overridden_baseline_dir(machine, baseline_dir=None): - """Get the baseline directory to use here, or None +def get_possibly_overridden_mach_value(machine, varname, value=None): + """Get the value to use for the given machine variable - If baseline_dir is provided (not None), use that. Otherwise use the baseline directory - from machine (which may be None). + If value is provided (not None), use that. Otherwise use the value of the given + variable from the provided machine object. Args: machine (Machine) - baseline_dir (str or None): gives the overriding baseline directory to use + varname (str): name of variable to get from the machine object + value: if not None, use this instead of fetching from the machine object """ - if baseline_dir is not None: - return baseline_dir - return machine.baseline_dir + if value is not None: + return value + return getattr(machine, varname) def _get_account(): account = get_project() diff --git a/python/ctsm/machine_defaults.py b/python/ctsm/machine_defaults.py index f4df95b768..637845d7eb 100644 --- a/python/ctsm/machine_defaults.py +++ b/python/ctsm/machine_defaults.py @@ -12,6 +12,7 @@ 'scratch_dir', 'baseline_dir', 'account_required', + 'create_test_retry', 'job_launcher_defaults']) # job_launcher_type: one of the JOB_LAUNCHERs defined in job_launcher_factory # scratch_dir: str @@ -21,6 +22,7 @@ # have 0, 1 or multiple job_launcher_defaults. (It can be useful to have defaults even # for the non-default job launcher for this machine, in case the user chooses a # non-default launcher.) +# create_test_retry: int: Default number of times to retry a create_test job on this machine # account_required: bool: whether an account number is required on this machine (not # really a default, but used for error-checking) @@ -40,6 +42,7 @@ scratch_dir=os.path.join(os.path.sep, 'glade', 'scratch', get_user()), baseline_dir=os.path.join(os.path.sep, 'glade', 'p', 'cgd', 'tss', 'ctsm_baselines'), account_required=True, + create_test_retry=0, job_launcher_defaults={ JOB_LAUNCHER_QSUB: QsubDefaults( queue='regular', @@ -49,13 +52,14 @@ # to add more flexibility in the future, making the node / proc counts # individually selectable required_args= - '-l select=1:ncpus=36:mpiprocs=1 -r n -l inception=login') + '-l select=1:ncpus=36:mpiprocs=1 -r n -l inception=login -k oed') }), 'hobart': MachineDefaults( job_launcher_type=JOB_LAUNCHER_QSUB, scratch_dir=os.path.join(os.path.sep, 'scratch', 'cluster', get_user()), baseline_dir=os.path.join(os.path.sep, 'fs', 'cgd', 'csm', 'ccsm_baselines'), account_required=False, + create_test_retry=0, job_launcher_defaults={ JOB_LAUNCHER_QSUB: QsubDefaults( queue='medium', @@ -68,6 +72,9 @@ scratch_dir=os.path.join(os.path.sep, 'scratch', 'cluster', get_user()), baseline_dir=os.path.join(os.path.sep, 'fs', 'cgd', 'csm', 'ccsm_baselines'), account_required=False, + # jobs on izumi experience a high frequency of failures, often at the very end of + # the job; so we'll automatically retry a failed job once before giving up on it + create_test_retry=1, job_launcher_defaults={ JOB_LAUNCHER_QSUB: QsubDefaults( queue='medium', diff --git a/python/ctsm/run_sys_tests.py b/python/ctsm/run_sys_tests.py index 7d5d0a2e94..f72d1863cf 100644 --- a/python/ctsm/run_sys_tests.py +++ b/python/ctsm/run_sys_tests.py @@ -8,17 +8,17 @@ import subprocess from datetime import datetime +from CIME.test_utils import get_tests_from_xml # pylint: disable=import-error +from CIME.cs_status_creator import create_cs_status # pylint: disable=import-error + from ctsm.ctsm_logging import setup_logging_pre_config, add_logging_args, process_logging_args from ctsm.machine_utils import get_machine_name -from ctsm.machine import create_machine, get_possibly_overridden_baseline_dir +from ctsm.machine import create_machine, get_possibly_overridden_mach_value from ctsm.machine_defaults import MACHINE_DEFAULTS from ctsm.os_utils import make_link from ctsm.path_utils import path_to_ctsm_root from ctsm.joblauncher.job_launcher_factory import JOB_LAUNCHER_NOBATCH -from CIME.test_utils import get_tests_from_xml # pylint: disable=import-error -from CIME.cs_status_creator import create_cs_status # pylint: disable=import-error - logger = logging.getLogger(__name__) # Number of initial characters from the compiler name to use in a testid @@ -72,6 +72,7 @@ def main(cime_path): compare_name=args.compare, generate_name=args.generate, baseline_root=args.baseline_root, walltime=args.walltime, queue=args.queue, + retry=args.retry, extra_create_test_args=args.extra_create_test_args) def run_sys_tests(machine, cime_path, @@ -85,6 +86,7 @@ def run_sys_tests(machine, cime_path, compare_name=None, generate_name=None, baseline_root=None, walltime=None, queue=None, + retry=None, extra_create_test_args=''): """Implementation of run_sys_tests command @@ -119,6 +121,8 @@ def run_sys_tests(machine, cime_path, determine it automatically) queue (str): queue to use for each test (if not provided, the test suite will determine it automatically) + retry (int): retry value to pass to create_test (if not provided, will use the default + for this machine) extra_create_test_args (str): any extra arguments to create_test, as a single, space-delimited string testlist: list of strings giving test names to run @@ -137,17 +141,22 @@ def run_sys_tests(machine, cime_path, if not (skip_testroot_creation or rerun_existing_failures): _make_testroot(testroot, testid_base, dry_run) print("Testroot: {}\n".format(testroot)) + retry_final = get_possibly_overridden_mach_value(machine, + varname='create_test_retry', + value=retry) if not skip_git_status: - _record_git_status(testroot, dry_run) + _record_git_status(testroot, retry_final, dry_run) - baseline_root_final = get_possibly_overridden_baseline_dir(machine, - baseline_dir=baseline_root) + baseline_root_final = get_possibly_overridden_mach_value(machine, + varname='baseline_dir', + value=baseline_root) create_test_args = _get_create_test_args(compare_name=compare_name, generate_name=generate_name, baseline_root=baseline_root_final, account=machine.account, walltime=walltime, queue=queue, + retry=retry_final, rerun_existing_failures=rerun_existing_failures, extra_create_test_args=extra_create_test_args) if suite_name: @@ -298,6 +307,11 @@ def _commandline_args(): help='Queue to which tests are submitted.\n' 'If not provided, uses machine default.') + parser.add_argument('--retry', type=int, + help='Argument to create_test: Number of times to retry failed tests.\n' + 'Default for this machine: {}'.format( + default_machine.create_test_retry)) + parser.add_argument('--extra-create-test-args', default='', help='String giving extra arguments to pass to create_test\n' '(To allow the argument parsing to accept this, enclose the string\n' @@ -396,11 +410,13 @@ def _make_testroot(testroot, testid_base, dry_run): os.makedirs(testroot) make_link(testroot, _get_testdir_name(testid_base)) -def _record_git_status(testroot, dry_run): +def _record_git_status(testroot, retry, dry_run): """Record git status and related information to stdout and a file""" output = '' ctsm_root = path_to_ctsm_root() + output += "create_test --retry: {}\n\n".format(retry) + current_hash = subprocess.check_output(['git', 'show', '--no-patch', '--format=format:%h (%an, %ad) %s\n', 'HEAD'], cwd=ctsm_root, @@ -440,7 +456,7 @@ def _record_git_status(testroot, dry_run): git_status_file.write(output) def _get_create_test_args(compare_name, generate_name, baseline_root, - account, walltime, queue, + account, walltime, queue, retry, rerun_existing_failures, extra_create_test_args): args = [] @@ -456,6 +472,7 @@ def _get_create_test_args(compare_name, generate_name, baseline_root, args.extend(['--walltime', walltime]) if queue: args.extend(['--queue', queue]) + args.extend(['--retry', str(retry)]) if rerun_existing_failures: # In addition to --use-existing, we also need --allow-baseline-overwrite in this # case; otherwise, create_test throws an error saying that the baseline diff --git a/python/ctsm/test/joblauncher/test_unit_job_launcher_no_batch.py b/python/ctsm/test/joblauncher/test_unit_job_launcher_no_batch.py old mode 100644 new mode 100755 index c407c62904..53bb6dc07d --- a/python/ctsm/test/joblauncher/test_unit_job_launcher_no_batch.py +++ b/python/ctsm/test/joblauncher/test_unit_job_launcher_no_batch.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """Unit tests for job_launcher_no_batch """ diff --git a/python/ctsm/test/test_sys_lilac_build_ctsm.py b/python/ctsm/test/test_sys_lilac_build_ctsm.py index 74121ba90d..5a44688171 100755 --- a/python/ctsm/test/test_sys_lilac_build_ctsm.py +++ b/python/ctsm/test/test_sys_lilac_build_ctsm.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """System tests for lilac_build_ctsm diff --git a/python/ctsm/test/test_unit_lilac_build_ctsm.py b/python/ctsm/test/test_unit_lilac_build_ctsm.py index 677de63da4..3c1a600326 100755 --- a/python/ctsm/test/test_unit_lilac_build_ctsm.py +++ b/python/ctsm/test/test_unit_lilac_build_ctsm.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """Unit tests for lilac_build_ctsm """ diff --git a/python/ctsm/test/test_unit_lilac_make_runtime_inputs.py b/python/ctsm/test/test_unit_lilac_make_runtime_inputs.py index 7c94089269..e6b602b3d7 100755 --- a/python/ctsm/test/test_unit_lilac_make_runtime_inputs.py +++ b/python/ctsm/test/test_unit_lilac_make_runtime_inputs.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """Unit tests for lilac_make_runtime_inputs """ diff --git a/python/ctsm/test/test_unit_machine.py b/python/ctsm/test/test_unit_machine.py index 2712ffafc7..6a2f7ac172 100755 --- a/python/ctsm/test/test_unit_machine.py +++ b/python/ctsm/test/test_unit_machine.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """Unit tests for machine """ @@ -9,7 +9,7 @@ from ctsm import add_cime_to_path # pylint: disable=unused-import from ctsm import unit_testing -from ctsm.machine import create_machine, get_possibly_overridden_baseline_dir +from ctsm.machine import create_machine, get_possibly_overridden_mach_value from ctsm.machine_utils import get_user from ctsm.machine_defaults import MACHINE_DEFAULTS, MachineDefaults, QsubDefaults from ctsm.joblauncher.job_launcher_no_batch import JobLauncherNoBatch @@ -23,7 +23,8 @@ class TestCreateMachine(unittest.TestCase): """Tests of create_machine""" - def assertMachineInfo(self, machine, name, scratch_dir, baseline_dir, account): + def assertMachineInfo(self, machine, name, scratch_dir, baseline_dir, account, + create_test_retry=0): """Asserts that the basic machine info is as expected. This does NOT dive down into the job launcher""" @@ -31,6 +32,7 @@ def assertMachineInfo(self, machine, name, scratch_dir, baseline_dir, account): self.assertEqual(machine.scratch_dir, scratch_dir) self.assertEqual(machine.baseline_dir, baseline_dir) self.assertEqual(machine.account, account) + self.assertEqual(machine.create_test_retry, create_test_retry) def assertNoBatchInfo(self, machine, nice_level=None): """Asserts that the machine's launcher is of type JobLauncherNoBatch""" @@ -62,6 +64,7 @@ def create_defaults(default_job_launcher=JOB_LAUNCHER_QSUB): scratch_dir=os.path.join(os.path.sep, 'glade', 'scratch', get_user()), baseline_dir=os.path.join(os.path.sep, 'my', 'baselines'), account_required=True, + create_test_retry=2, job_launcher_defaults={ JOB_LAUNCHER_QSUB: QsubDefaults( queue='regular', @@ -130,7 +133,8 @@ def test_knownMachine_defaults(self): 'scratch', get_user()), baseline_dir=os.path.join(os.path.sep, 'my', 'baselines'), - account='a123') + account='a123', + create_test_retry=2) self.assertQsubInfo(machine=machine, queue='regular', walltime='06:00:00', @@ -152,7 +156,8 @@ def test_knownMachine_argsExplicit(self): name='cheyenne', scratch_dir='/custom/path/to/scratch', baseline_dir=os.path.join(os.path.sep, 'my', 'baselines'), - account='a123') + account='a123', + create_test_retry=2) self.assertQsubInfo(machine=machine, queue='custom_queue', walltime='9:87:65', @@ -161,29 +166,35 @@ def test_knownMachine_argsExplicit(self): extra_args='--custom args') # ------------------------------------------------------------------------ - # Tests of get_possibly_overridden_baseline_dir + # Tests of get_possibly_overridden_mach_value # ------------------------------------------------------------------------ def test_baselineDir_overridden(self): - """Tests get_possibly_overridden_baseline_dir when baseline_dir is provided""" + """Tests get_possibly_overridden_mach_value when baseline_dir is provided""" defaults = self.create_defaults() machine = create_machine('cheyenne', defaults, account='a123') - baseline_dir = get_possibly_overridden_baseline_dir(machine, baseline_dir='mypath') + baseline_dir = get_possibly_overridden_mach_value(machine, + varname='baseline_dir', + value='mypath') self.assertEqual(baseline_dir, 'mypath') def test_baselineDir_default(self): - """Tests get_possibly_overridden_baseline_dir when baseline_dir is not provided""" + """Tests get_possibly_overridden_mach_value when baseline_dir is not provided""" defaults = self.create_defaults() machine = create_machine('cheyenne', defaults, account='a123') - baseline_dir = get_possibly_overridden_baseline_dir(machine, baseline_dir=None) + baseline_dir = get_possibly_overridden_mach_value(machine, + varname='baseline_dir', + value=None) self.assertEqual(baseline_dir, os.path.join(os.path.sep, 'my', 'baselines')) def test_baselineDir_noDefault(self): - """Tests get_possibly_overridden_baseline_dir when baseline_dir is not provided + """Tests get_possibly_overridden_mach_value when baseline_dir is not provided and there is no default""" machine = create_machine('unknown_test_machine', MACHINE_DEFAULTS, account='a123') - baseline_dir = get_possibly_overridden_baseline_dir(machine, baseline_dir=None) + baseline_dir = get_possibly_overridden_mach_value(machine, + varname='baseline_dir', + value=None) self.assertIsNone(baseline_dir) if __name__ == '__main__': diff --git a/python/ctsm/test/test_unit_path_utils.py b/python/ctsm/test/test_unit_path_utils.py index 9d4d1a78ff..9fc996aa2c 100755 --- a/python/ctsm/test/test_unit_path_utils.py +++ b/python/ctsm/test/test_unit_path_utils.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """Unit tests for path_utils """ diff --git a/python/ctsm/test/test_unit_run_sys_tests.py b/python/ctsm/test/test_unit_run_sys_tests.py index 316fd40a2d..8a53081a5b 100755 --- a/python/ctsm/test/test_unit_run_sys_tests.py +++ b/python/ctsm/test/test_unit_run_sys_tests.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """Unit tests for run_sys_tests """ @@ -100,8 +100,8 @@ def test_createTestCommand_testnames(self): (1) The use of a testlist argument (2) The standard arguments to create_test (the path to create_test, the arguments - --test-id and --output-root, the absence of --compare and --generate, and (on this - unknown machine) the absence of --baseline-root) + --test-id, --output-root and --retry, the absence of --compare and --generate, and + (on this unknown machine) the absence of --baseline-root) (3) That a cs.status.fails file was created """ @@ -119,6 +119,7 @@ def test_createTestCommand_testnames(self): six.assertRegex(self, command, r'--test-id +{}\s'.format(self._expected_testid())) expected_testroot_path = os.path.join(self._scratch, self._expected_testroot()) six.assertRegex(self, command, r'--output-root +{}\s'.format(expected_testroot_path)) + six.assertRegex(self, command, r'--retry +0(\s|$)') six.assertRegex(self, command, r'test1 +test2(\s|$)') assertNotRegex(self, command, r'--compare\s') assertNotRegex(self, command, r'--generate\s') @@ -151,6 +152,7 @@ def test_createTestCommand_testfileAndExtraArgs(self): baseline_root='myblroot', walltime='3:45:67', queue='runqueue', + retry=5, extra_create_test_args='--some extra --createtest args') all_commands = machine.job_launcher.get_commands() @@ -166,6 +168,7 @@ def test_createTestCommand_testfileAndExtraArgs(self): six.assertRegex(self, command, r'--walltime +3:45:67(\s|$)') six.assertRegex(self, command, r'--queue +runqueue(\s|$)') six.assertRegex(self, command, r'--project +myaccount(\s|$)') + six.assertRegex(self, command, r'--retry +5(\s|$)') six.assertRegex(self, command, r'--some +extra +--createtest +args(\s|$)') expected_cs_status = os.path.join(expected_testroot, diff --git a/python/ctsm/test/test_unit_utils.py b/python/ctsm/test/test_unit_utils.py index 34449aa93c..4a3fbbbb15 100755 --- a/python/ctsm/test/test_unit_utils.py +++ b/python/ctsm/test/test_unit_utils.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """Unit tests for utils """ diff --git a/python/ctsm/utils.py b/python/ctsm/utils.py index 09a08ff9af..44cce0cccf 100644 --- a/python/ctsm/utils.py +++ b/python/ctsm/utils.py @@ -3,6 +3,7 @@ import logging import sys import string +import pdb logger = logging.getLogger(__name__) @@ -12,7 +13,6 @@ def abort(errmsg): No traceback is given, but if the logging level is DEBUG, then we'll enter pdb """ if logger.isEnabledFor(logging.DEBUG): - import pdb pdb.set_trace() sys.exit('ERROR: {}'.format(errmsg)) diff --git a/python/run_ctsm_py_tests b/python/run_ctsm_py_tests index ef56f74740..a3da6fdb1f 100755 --- a/python/run_ctsm_py_tests +++ b/python/run_ctsm_py_tests @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """Driver for running the unit tests of the python code We use this rather than simply relying on 'python -m unittest discover' so we can do some diff --git a/run_sys_tests b/run_sys_tests index bccf6f00e1..48e6c71370 100755 --- a/run_sys_tests +++ b/run_sys_tests @@ -1,4 +1,4 @@ -#!/usr/bin/env python +#!/usr/bin/env python3 """Driver for running CTSM system tests""" import os diff --git a/src/biogeochem/CNFUNMod.F90 b/src/biogeochem/CNFUNMod.F90 index 4edf4d748e..6ab724aae2 100644 --- a/src/biogeochem/CNFUNMod.F90 +++ b/src/biogeochem/CNFUNMod.F90 @@ -1584,10 +1584,7 @@ real(r8) function fun_cost_fix(fixer,a_fix,b_fix,c_fix,big_cost,crootfr,s_fix, t real(r8), intent(in) :: tc_soisno ! soil temperature (degrees Celsius) if (fixer == 1 .and. crootfr > 1.e-6_r8) then - fun_cost_fix = s_fix * (exp(a_fix + b_fix * tc_soisno * (1._r8 - 0.5_r8 * tc_soisno / c_fix)) - 2._r8) - - - ! New term to directly account for Ben Houlton's temperature response function. + ! New term to directly account for Ben Houlton's temperature response function. ! Assumes s_fix is -6. (RF, Jan 2015) ! 1.25 converts from the Houlton temp response function to a 0-1 limitation factor. ! The cost of N should probably be 6 gC/gN (or 9, including maintenance costs of nodules) diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index 28c0ff99ec..e81883ea91 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -94,7 +94,9 @@ module CNPhenologyMod integer, allocatable :: maxplantjday(:,:) ! maximum planting julian day integer :: jdayyrstart(inSH) ! julian day of start of year - real(r8), private :: initial_seed_at_planting = 3._r8 ! Initial seed at planting + real(r8), private :: initial_seed_at_planting = 3._r8 ! Initial seed at planting + logical, private :: min_crtical_dayl_depends_on_lat = .false. ! If critical day-length for onset depends on latitude + logical, private :: onset_thresh_depends_on_veg = .false. ! If onset threshold depends on vegetation type character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -125,7 +127,8 @@ subroutine CNPhenologyReadNML( NLFilename ) character(len=*), parameter :: subname = 'CNPhenologyReadNML' character(len=*), parameter :: nmlname = 'cnphenology' !----------------------------------------------------------------------- - namelist /cnphenology/ initial_seed_at_planting + namelist /cnphenology/ initial_seed_at_planting, onset_thresh_depends_on_veg, & + min_crtical_dayl_depends_on_lat ! Initialize options to default values, in case they are not specified in ! the namelist @@ -146,7 +149,9 @@ subroutine CNPhenologyReadNML( NLFilename ) call relavu( unitn ) end if - call shr_mpi_bcast (initial_seed_at_planting, mpicom) + call shr_mpi_bcast (initial_seed_at_planting, mpicom) + call shr_mpi_bcast (onset_thresh_depends_on_veg, mpicom) + call shr_mpi_bcast (min_crtical_dayl_depends_on_lat, mpicom) if (masterproc) then write(iulog,*) ' ' @@ -252,7 +257,7 @@ subroutine CNPhenology (bounds, num_soilc, filter_soilc, num_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, & + temperature_inst, waterdiagnosticbulk_inst, cnveg_state_inst, dgvs_inst, & cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) call CNStressDecidPhenology(num_soilp, filter_soilp, & @@ -627,7 +632,7 @@ end subroutine CNEvergreenPhenology !----------------------------------------------------------------------- subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & - temperature_inst, cnveg_state_inst, dgvs_inst , & + temperature_inst, waterdiagnosticbulk_inst, cnveg_state_inst, dgvs_inst , & cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst) ! ! !DESCRIPTION: @@ -644,6 +649,7 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & 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(waterdiagnosticbulk_type) , intent(in) :: waterdiagnosticbulk_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 @@ -656,6 +662,8 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & 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):: crit_daylat !latitudinal light gradient in arctic-boreal + real(r8):: onset_thresh !flag onset threshold real(r8):: soilt !----------------------------------------------------------------------- @@ -666,9 +674,13 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & 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) + season_decid_temperate => pftcon%season_decid_temperate , & ! Input: binary flag for seasonal-deciduous temperate leaf habit (0 or 1) t_soisno => temperature_inst%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevgrnd) - + soila10 => temperature_inst%soila10_patch , & ! Input: [real(r8) (:) ] + t_a5min => temperature_inst%t_a5min_patch , & ! input: [real(r8) (:) ] + snow_5day => waterdiagnosticbulk_inst%snow_5day_col , & ! input: [real(r8) (:) ] + 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) @@ -742,6 +754,8 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & ) ! start patch loop + + do fp = 1,num_soilp p = filter_soilp(fp) c = patch%column(p) @@ -838,7 +852,7 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & ! test for switching from dormant period to growth period if (dormant_flag(p) == 1.0_r8) then - + onset_thresh = 0.0_r8 ! Test to turn on growing degree-day sum, if off. ! switch on the growing degree day sum on the winter solstice @@ -865,13 +879,29 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & 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 + if ( onset_thresh_depends_on_veg ) then + ! separate into non-arctic seasonally deciduous pfts (temperate broadleaf deciduous + ! tree) and arctic/boreal seasonally deciduous pfts (boreal needleleaf deciduous tree, + ! boreal broadleaf deciduous tree, boreal broadleaf deciduous shrub, C3 arctic grass) + if (onset_gdd(p) > crit_onset_gdd .and. season_decid_temperate(ivt(p)) == 1) then + onset_thresh=1.0_r8 + else if (season_decid_temperate(ivt(p)) == 0 .and. onset_gddflag(p) == 1.0_r8 .and. & + soila10(p) > SHR_CONST_TKFRZ .and. & + t_a5min(p) > SHR_CONST_TKFRZ .and. ws_flag==1.0_r8 .and. & + dayl(g)>(crit_dayl/2.0_r8) .and. snow_5day(c)<0.1_r8) then + onset_thresh=1.0_r8 + end if + else + ! set onset_flag if critical growing degree-day sum is exceeded + if (onset_gdd(p) > crit_onset_gdd) onset_thresh = 1.0_r8 + end if + ! If onset is being triggered + if (onset_thresh == 1.0_r8) 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_thresh = 0.0_r8 onset_counter(p) = ndays_on * secspday ! move all the storage pools into transfer pools, @@ -913,8 +943,19 @@ subroutine CNSeasonDecidPhenology (num_soilp, filter_soilp , & if (days_active(p) > 355._r8) pftmayexist(p) = .false. end if + if ( min_crtical_dayl_depends_on_lat )then + ! use 15 hr (54000 min) at ~65N from eitel 2019, to ~11hours in temperate regions + ! 15hr-11hr/(65N-45N)=linear slope = 720 min/latitude + crit_daylat=54000-720*(65-abs(grc%latdeg(g))) + if (crit_daylat < crit_dayl) then + crit_daylat = crit_dayl !maintain previous offset from White 2001 as minimum + end if + else + crit_daylat = crit_dayl + 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 + if (ws_flag == 0._r8 .and. dayl(g) < crit_daylat) then offset_flag(p) = 1._r8 offset_counter(p) = ndays_off * secspday prev_leafc_to_litter(p) = 0._r8 diff --git a/src/biogeochem/CNSharedParamsMod.F90 b/src/biogeochem/CNSharedParamsMod.F90 index 8a4eafc99a..f38a7debb5 100644 --- a/src/biogeochem/CNSharedParamsMod.F90 +++ b/src/biogeochem/CNSharedParamsMod.F90 @@ -2,6 +2,8 @@ module CNSharedParamsMod !----------------------------------------------------------------------- ! + ! Parameters that are shared by the Carbon Nitrogen Biogeochemistry modules + ! ! !USES: use shr_kind_mod , only: r8 => shr_kind_r8 implicit none @@ -24,8 +26,20 @@ module CNSharedParamsMod type(CNParamsShareType), protected :: CNParamsShareInst + ! Public subroutines + public :: CNParamsReadShared ! Read in CN shared parameters + public :: CNParamsSetSoilDepth ! Set the soil depth needed for CNPhenology + public :: CNParamsReadShared_namelist ! Read in CN shared namelist items + + ! Public data + logical, public :: use_fun = .false. ! Use the FUN2.0 model integer, public :: nlev_soildecomp_standard = 5 + integer, public :: upper_soil_layer = -1 ! Upper soil layer to use for 10-day average in CNPhenology + + ! Private subroutines and data + + private :: CNParamsReadShared_netcdf ! Read shared parameters from NetCDF file character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -36,7 +50,7 @@ module CNSharedParamsMod !----------------------------------------------------------------------- subroutine CNParamsReadShared(ncid, namelist_file) - use ncdio_pio , only : file_desc_t + use ncdio_pio , only : file_desc_t type(file_desc_t), intent(inout) :: ncid ! pio netCDF file id character(len=*), intent(in) :: namelist_file @@ -46,6 +60,13 @@ subroutine CNParamsReadShared(ncid, namelist_file) end subroutine CNParamsReadShared + !----------------------------------------------------------------------- + + subroutine CNParamsSetSoilDepth( ) + use initVerticalMod, only : find_soil_layer_containing_depth + ! Set the soil depth needed for CNPhenology + call find_soil_layer_containing_depth ( 0.12_r8, upper_soil_layer ) + end subroutine CNParamsSetSoilDepth !----------------------------------------------------------------------- subroutine CNParamsReadShared_netcdf(ncid) ! diff --git a/src/biogeochem/CNVegCarbonStateType.F90 b/src/biogeochem/CNVegCarbonStateType.F90 index f7c9178453..28cf07869b 100644 --- a/src/biogeochem/CNVegCarbonStateType.F90 +++ b/src/biogeochem/CNVegCarbonStateType.F90 @@ -872,7 +872,7 @@ subroutine InitCold(this, bounds, ratio, carbon_type, c12_cnveg_carbonstate_inst ! ! !USES: use landunit_varcon , only : istsoil, istcrop - use clm_varctl, only : MM_Nuptake_opt + use clm_varctl, only : MM_Nuptake_opt, spinup_state ! ! !ARGUMENTS: class(cnveg_carbonstate_type) :: this @@ -895,6 +895,8 @@ subroutine InitCold(this, bounds, ratio, carbon_type, c12_cnveg_carbonstate_inst call endrun(msg=' ERROR: for C13 or C14 must pass in c12_cnveg_carbonstate_inst as argument' //& errMsg(sourcefile, __LINE__)) end if + else + if ( spinup_state == 2 ) spinup_factor_deadwood = spinup_factor_AD end if ! Set column filters @@ -1247,7 +1249,6 @@ subroutine Restart ( this, bounds, ncid, flag, carbon_type, reseed_dead_plants, if (flag == 'read' .and. spinup_state /= restart_file_spinup_state .and. .not. use_cndv) then if ( masterproc ) write(iulog, *) 'exit_spinup ',exit_spinup,' restart_file_spinup_state ',restart_file_spinup_state - if ( spinup_state == 2 ) spinup_factor_deadwood = spinup_factor_AD if (spinup_state <= 1 .and. restart_file_spinup_state == 2 ) then if ( masterproc ) write(iulog,*) ' CNRest: taking Dead wood C pools out of AD spinup mode' exit_spinup = .true. diff --git a/src/biogeochem/CNVegStructUpdateMod.F90 b/src/biogeochem/CNVegStructUpdateMod.F90 index 1c0ec70fa0..a3e0438544 100644 --- a/src/biogeochem/CNVegStructUpdateMod.F90 +++ b/src/biogeochem/CNVegStructUpdateMod.F90 @@ -181,6 +181,17 @@ subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & tsai_min = tsai_min * 0.5_r8 tsai(p) = max(tsai_alpha*tsai_old+max(tlai_old-tlai(p),0._r8),tsai_min) + ! calculate vegetation physiological parameters used in biomass heat storage + ! + if (use_biomass_heat_storage) then + ! Assumes fbw (fraction of biomass that is water) is the same for leaves and stems + leaf_biomass(p) = max(0.0025_r8,leafc(p)) & + * c_to_b * 1.e-3_r8 / (1._r8 - fbw(ivt(p))) + + else + leaf_biomass(p) = 0_r8 + end if + if (woody(ivt(p)) == 1._r8) then ! trees and shrubs for now have a very simple allometry, with hard-wired @@ -204,22 +215,15 @@ subroutine CNVegStructUpdate(bounds,num_soilp, filter_soilp, & endif - ! - ! calculate vegetation physiological parameters used in biomass heat storage - ! if (use_biomass_heat_storage) then ! Assumes fbw (fraction of biomass that is water) is the same for leaves and stems - leaf_biomass(p) = max(0.0025_r8,leafc(p)) & - * c_to_b * 1.e-3_r8 / (1._r8 - fbw(ivt(p))) - stem_biomass(p) = (spinup_factor_deadwood*deadstemc(p) + livestemc(p)) & * c_to_b * 1.e-3_r8 / (1._r8 - fbw(ivt(p))) - else - leaf_biomass(p) = 0_r8 stem_biomass(p) = 0_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. diff --git a/src/biogeochem/CNVegetationFacade.F90 b/src/biogeochem/CNVegetationFacade.F90 index 9ef32b4563..98995626b0 100644 --- a/src/biogeochem/CNVegetationFacade.F90 +++ b/src/biogeochem/CNVegetationFacade.F90 @@ -1127,7 +1127,9 @@ subroutine BalanceCheck(this, bounds, num_soilc, filter_soilc, & DA_nstep = get_nstep_since_startup_or_lastDA_restart_or_pause() if (DA_nstep <= skip_steps )then if (masterproc) then +!$OMP MASTER write(iulog,*) '--WARNING-- skipping CN balance check for first timesteps after startup or data assimilation' +!$OMP END MASTER end if else diff --git a/src/biogeochem/DryDepVelocity.F90 b/src/biogeochem/DryDepVelocity.F90 index 99daf9580c..37860e9728 100644 --- a/src/biogeochem/DryDepVelocity.F90 +++ b/src/biogeochem/DryDepVelocity.F90 @@ -192,7 +192,7 @@ subroutine depvel_compute( bounds, & use shr_const_mod , only : tmelt => shr_const_tkfrz use seq_drydep_mod , only : seq_drydep_setHCoeff, mapping, drat, foxd use seq_drydep_mod , only : rcls, h2_a, h2_b, h2_c, ri, rac, rclo, rlu, rgss, rgso - use landunit_varcon, only : istsoil, istice_mec, istdlak, istwet + use landunit_varcon, only : istsoil, istice, 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 @@ -380,7 +380,7 @@ subroutine depvel_compute( bounds, & index_season = -1 if ( lun%itype(l) /= istsoil )then - if ( lun%itype(l) == istice_mec ) then + if ( lun%itype(l) == istice ) then wesveg = 8 index_season = 4 elseif ( lun%itype(l) == istdlak ) then diff --git a/src/biogeochem/FireEmisFactorsMod.F90 b/src/biogeochem/FireEmisFactorsMod.F90 index 7aef11ffc3..e97082c0b8 100644 --- a/src/biogeochem/FireEmisFactorsMod.F90 +++ b/src/biogeochem/FireEmisFactorsMod.F90 @@ -227,7 +227,7 @@ integer function gen_hashkey(string) integer :: i integer :: strlen integer, parameter :: tbl_max_idx = 15 ! 2**N - 1 - integer, parameter :: gen_hash_key_offset = z'000053db' + integer, parameter :: gen_hash_key_offset = int(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 diff --git a/src/biogeochem/MEGANFactorsMod.F90 b/src/biogeochem/MEGANFactorsMod.F90 index 8c91959b88..661bfbdde2 100644 --- a/src/biogeochem/MEGANFactorsMod.F90 +++ b/src/biogeochem/MEGANFactorsMod.F90 @@ -274,7 +274,7 @@ integer function gen_hashkey(string) integer :: i integer, parameter :: tbl_max_idx = 15 ! 2**N - 1 - integer, parameter :: gen_hash_key_offset = z'000053db' + integer, parameter :: gen_hash_key_offset = int(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 diff --git a/src/biogeochem/SatellitePhenologyMod.F90 b/src/biogeochem/SatellitePhenologyMod.F90 index 7b5aea35dd..1d273a9e64 100644 --- a/src/biogeochem/SatellitePhenologyMod.F90 +++ b/src/biogeochem/SatellitePhenologyMod.F90 @@ -17,7 +17,6 @@ module SatellitePhenologyMod 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, inst_name use clm_varcon , only : grlnd use controlMod , only : NLFilename @@ -501,7 +500,6 @@ subroutine readAnnualVegetation (bounds, canopystate_inst) 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 @@ -511,7 +509,6 @@ subroutine readAnnualVegetation (bounds, canopystate_inst) 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 @@ -520,7 +517,6 @@ subroutine readAnnualVegetation (bounds, canopystate_inst) 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' @@ -553,11 +549,6 @@ subroutine readAnnualVegetation (bounds, canopystate_inst) end if call check_dim_size(ncid, 'lsmpft', maxsoil_patches) - 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, & @@ -600,7 +591,6 @@ subroutine readMonthlyVegetation (bounds, & 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 ! @@ -620,8 +610,6 @@ subroutine readMonthlyVegetation (bounds, & 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 @@ -651,11 +639,6 @@ subroutine readMonthlyVegetation (bounds, & 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, & diff --git a/src/biogeophys/BalanceCheckMod.F90 b/src/biogeophys/BalanceCheckMod.F90 index a219a0b05d..7df5b10327 100644 --- a/src/biogeophys/BalanceCheckMod.F90 +++ b/src/biogeophys/BalanceCheckMod.F90 @@ -11,19 +11,20 @@ module BalanceCheckMod use decompMod , only : bounds_type use abortutils , only : endrun use clm_varctl , only : iulog - use clm_varcon , only : namep, namec + use clm_varctl , only : use_fates_planthydro + use clm_varcon , only : namep, namec, nameg use clm_varpar , only : nlevsoi use GetGlobalValuesMod , only : GetGlobalIndex use atm2lndType , only : atm2lnd_type use EnergyFluxType , only : energyflux_type use SolarAbsorbedType , only : solarabs_type use SoilHydrologyType , only : soilhydrology_type - use SurfaceAlbedoType , only : surfalb_type use WaterStateType , only : waterstate_type use LakestateType , only : lakestate_type use WaterDiagnosticBulkType, only : waterdiagnosticbulk_type use WaterDiagnosticType, only : waterdiagnostic_type use Wateratm2lndType , only : wateratm2lnd_type + use Waterlnd2atmType , only : waterlnd2atm_type use WaterBalanceType , only : waterbalance_type use WaterFluxType , only : waterflux_type use WaterType , only : water_type @@ -32,7 +33,7 @@ module BalanceCheckMod use LandunitType , only : lun use ColumnType , only : col use PatchType , only : patch - use landunit_varcon , only : istdlak, istsoil,istcrop,istwet,istice_mec + use landunit_varcon , only : istdlak, istsoil,istcrop,istwet,istice use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall use column_varcon , only : icol_road_perv, icol_road_imperv ! @@ -44,8 +45,9 @@ module BalanceCheckMod ! !PUBLIC MEMBER FUNCTIONS: public :: BalanceCheckInit ! Initialization of Water and energy balance check - public :: BeginWaterBalance ! Initialize water balance check - public :: BalanceCheck ! Water and energy balance check + public :: WaterGridcellBalance ! Grid cell-level water balance check + public :: BeginWaterColumnBalance ! Initialize column-level water balance check + public :: BalanceCheck ! Water & energy balance checks public :: GetBalanceCheckSkipSteps ! Get the number of steps to skip for the balance check public :: BalanceCheckClean ! Clean up for BalanceCheck @@ -55,7 +57,8 @@ module BalanceCheckMod ! ! !PRIVATE MEMBER FUNCTIONS: - private :: BeginWaterBalanceSingle ! Initialize water balance check for bulk or a single tracer + private :: WaterGridcellBalanceSingle ! Grid cell-level water balance check for bulk or a single tracer + private :: BeginWaterColumnBalanceSingle ! Initialize column-level water balance check for bulk or a single tracer character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -121,7 +124,46 @@ end function GetBalanceCheckSkipSteps !----------------------------------------------------------------------- !----------------------------------------------------------------------- - subroutine BeginWaterBalance(bounds, & + subroutine WaterGridcellBalance(bounds, & + num_nolakec, filter_nolakec, num_lakec, filter_lakec, & + water_inst, lakestate_inst, use_aquifer_layer, flag) + ! + ! !DESCRIPTION: + ! Grid cell-level water balance for bulk water and each water tracer + ! + ! !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 lake points in column filter + integer , intent(in) :: filter_lakec(:) ! column filter for lake points + type(water_type) , intent(inout) :: water_inst + type(lakestate_type) , intent(in) :: lakestate_inst + logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run + character(len=5) , intent(in) :: flag ! specifies begwb or endwb + ! + ! !LOCAL VARIABLES: + integer :: i + + character(len=*), parameter :: subname = 'WaterGridcellBalance' + !----------------------------------------------------------------------- + + do i = water_inst%bulk_and_tracers_beg, water_inst%bulk_and_tracers_end + ! Obtain begwb_grc or endwb_grc + call WaterGridcellBalanceSingle(bounds, & + num_nolakec, filter_nolakec, num_lakec, filter_lakec, & + lakestate_inst, & + water_inst%bulk_and_tracers(i)%waterstate_inst, & + water_inst%bulk_and_tracers(i)%waterdiagnostic_inst, & + water_inst%bulk_and_tracers(i)%waterbalance_inst, & + water_inst%bulk_and_tracers(i)%waterflux_inst, & + use_aquifer_layer = use_aquifer_layer, flag = flag) + end do + + end subroutine WaterGridcellBalance + + !----------------------------------------------------------------------- + subroutine BeginWaterColumnBalance(bounds, & num_nolakec, filter_nolakec, num_lakec, filter_lakec, & water_inst, soilhydrology_inst, lakestate_inst, & use_aquifer_layer) @@ -144,11 +186,11 @@ subroutine BeginWaterBalance(bounds, & ! !LOCAL VARIABLES: integer :: i - character(len=*), parameter :: subname = 'BeginWaterBalance' + character(len=*), parameter :: subname = 'BeginWaterColumnBalance' !----------------------------------------------------------------------- do i = water_inst%bulk_and_tracers_beg, water_inst%bulk_and_tracers_end - call BeginWaterBalanceSingle(bounds, & + call BeginWaterColumnBalanceSingle(bounds, & num_nolakec, filter_nolakec, & num_lakec, filter_lakec, & soilhydrology_inst, & @@ -159,10 +201,139 @@ subroutine BeginWaterBalance(bounds, & use_aquifer_layer = use_aquifer_layer) end do - end subroutine BeginWaterBalance + end subroutine BeginWaterColumnBalance !----------------------------------------------------------------------- - subroutine BeginWaterBalanceSingle(bounds, & + subroutine WaterGridcellBalanceSingle(bounds, & + num_nolakec, filter_nolakec, num_lakec, filter_lakec, & + lakestate_inst, waterstate_inst, waterdiagnostic_inst, & + waterbalance_inst, waterflux_inst, use_aquifer_layer, flag) + ! + ! !DESCRIPTION: + ! Grid cell-level water balance for bulk or a single tracer + ! at beginning or end of time step as specified by "flag" + ! + ! !USES: + use subgridAveMod, only: c2g + ! + ! !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 lake points in column filter + integer , intent(in) :: filter_lakec(:) ! column filter for lake points + type(lakestate_type) , intent(in) :: lakestate_inst + class(waterstate_type) , intent(inout) :: waterstate_inst + class(waterdiagnostic_type), intent(in) :: waterdiagnostic_inst + class(waterbalance_type) , intent(inout) :: waterbalance_inst + class(waterflux_type) , intent(inout) :: waterflux_inst + logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run + character(len=5) , intent(in) :: flag ! specifies begwb or endwb + ! + ! !LOCAL VARIABLES: + integer :: g ! indices + integer :: begc, endc, begg, endg ! bounds + real(r8) :: wb_col(bounds%begc:bounds%endc) ! temporary column-level water mass + real(r8) :: wb_grc(bounds%begg:bounds%endg) ! temporary grid cell-level water mass + real(r8) :: qflx_liq_dynbal_left_to_dribble(bounds%begg:bounds%endg) ! grc liq dynamic land cover change conversion runoff flux + real(r8) :: qflx_ice_dynbal_left_to_dribble(bounds%begg:bounds%endg) ! grc ice dynamic land cover change conversion runoff flux + real(r8) :: wa_reset_nonconservation_gain_grc(bounds%begg:bounds%endg) ! grc mass gained from resetting water in the unconfined aquifer, wa_col (negative indicates mass lost) (mm) + + character(len=*), parameter :: subname = 'WaterGridcellBalanceSingle' + !----------------------------------------------------------------------- + + associate( & + begwb_grc => waterbalance_inst%begwb_grc, & ! Output: [real(r8) (:)] grid cell-level water mass begining of the time step + endwb_grc => waterbalance_inst%endwb_grc, & ! Output: [real(r8) (:)] grid cell-level water mass end of the time step + wa_reset_nonconservation_gain_col => waterbalance_inst%wa_reset_nonconservation_gain_col & ! Input: [real(r8) (:)] col mass gained from resetting water in the unconfined aquifer, wa_col (negative indicates mass lost) (mm) + ) + + begc = bounds%begc + endc = bounds%endc + begg = bounds%begg + endg = bounds%endg + + call ComputeWaterMassNonLake(bounds, num_nolakec, filter_nolakec, & + waterstate_inst, waterdiagnostic_inst, & + subtract_dynbal_baselines = .true., & + water_mass = wb_col(begc:endc)) + + call ComputeWaterMassLake(bounds, num_lakec, filter_lakec, & + waterstate_inst, lakestate_inst, & + add_lake_water_and_subtract_dynbal_baselines = .true., & + water_mass = wb_col(begc:endc)) + + call c2g(bounds, wb_col(begc:endc), wb_grc(begg:endg), & + c2l_scale_type='urbanf', l2g_scale_type='unity') + + ! Call the beginning or ending version of the subroutine according + ! to flag value + if (flag == 'begwb') then + call waterflux_inst%qflx_liq_dynbal_dribbler%get_amount_left_to_dribble_beg( & + bounds, & + qflx_liq_dynbal_left_to_dribble(begg:endg)) + call waterflux_inst%qflx_ice_dynbal_dribbler%get_amount_left_to_dribble_beg( & + bounds, & + qflx_ice_dynbal_left_to_dribble(begg:endg)) + else if (flag == 'endwb') then + call waterflux_inst%qflx_liq_dynbal_dribbler%get_amount_left_to_dribble_end( & + bounds, & + qflx_liq_dynbal_left_to_dribble(begg:endg)) + call waterflux_inst%qflx_ice_dynbal_dribbler%get_amount_left_to_dribble_end( & + bounds, & + qflx_ice_dynbal_left_to_dribble(begg:endg)) + else + write(iulog,*) 'Unknown flag passed into this subroutine.' + write(iulog,*) 'Expecting either begwb or endwb.' + call endrun(msg=errmsg(sourcefile, __LINE__)) + end if + + ! These dynbal dribblers store the delta state, (end - beg). Thus, the + ! amount dribbled out is the negative of the amount stored in the + ! dribblers. Therefore, conservation requires us to subtract the amount + ! remaining to dribble. + ! This sign convention is opposite to the convention chosen for the + ! respective dribble terms used in the carbon balance. At some point + ! it may be worth making the two conventions consistent. + do g = begg, endg + wb_grc(g) = wb_grc(g) - qflx_liq_dynbal_left_to_dribble(g) & + - qflx_ice_dynbal_left_to_dribble(g) + end do + + ! Map wb_grc to beginning/ending water balance according to flag + if (flag == 'begwb') then + do g = begg, endg + begwb_grc(g) = wb_grc(g) + end do + else if (flag == 'endwb') then + ! endwb_grc requires one more step first + if (use_aquifer_layer) then + ! wa_reset_nonconservation_gain may be non-zero only when + ! use_aquifer_layer is true. We do this c2g call only when needed + ! to avoid unnecessary calculations; by adding this term only when + ! use_aquifer_layer is true, we effectively let the balance checks + ! ensure that this term is zero when use_aquifer_layer is false, + ! as it should be. + ! The _col term was determined in BeginWaterColumnBalanceSingle + ! after any dynamic landuse adjustments. + call c2g( bounds, & + wa_reset_nonconservation_gain_col(begc:endc), & + wa_reset_nonconservation_gain_grc(begg:endg), & + c2l_scale_type='urbanf', l2g_scale_type='unity' ) + else + wa_reset_nonconservation_gain_grc(begg:endg) = 0._r8 + end if + do g = begg, endg + endwb_grc(g) = wb_grc(g) - wa_reset_nonconservation_gain_grc(g) + end do + end if + + end associate + + end subroutine WaterGridcellBalanceSingle + + !----------------------------------------------------------------------- + subroutine BeginWaterColumnBalanceSingle(bounds, & num_nolakec, filter_nolakec, num_lakec, filter_lakec, & soilhydrology_inst, lakestate_inst, waterstate_inst, & waterdiagnostic_inst, waterbalance_inst, & @@ -186,28 +357,51 @@ subroutine BeginWaterBalanceSingle(bounds, & logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run ! ! !LOCAL VARIABLES: - integer :: c, j, fc ! indices + integer :: c, fc ! indices !----------------------------------------------------------------------- associate( & zi => col%zi , & ! Input: [real(r8) (:,:) ] interface level below a "z" level (m) zwt => soilhydrology_inst%zwt_col , & ! Input: [real(r8) (:) ] water table depth (m) - aquifer_water_baseline => waterstate_inst%aquifer_water_baseline, & ! Input: [real(r8)] baseline value for water in the unconfined aquifer (wa_col) for this bulk / tracer (mm) + aquifer_water_baseline => waterstate_inst%aquifer_water_baseline, & ! Input: [real(r8)] baseline value for water in the unconfined aquifer (wa_col) for this bulk / tracer (mm) wa => waterstate_inst%wa_col , & ! Output: [real(r8) (:) ] water in the unconfined aquifer (mm) + wa_reset_nonconservation_gain => waterbalance_inst%wa_reset_nonconservation_gain_col , & ! Output: [real(r8) (:) ] mass gained from resetting water in the unconfined aquifer, wa_col (negative indicates mass lost) (mm) begwb => waterbalance_inst%begwb_col , & ! Output: [real(r8) (:) ] water mass begining of the time step h2osno_old => waterbalance_inst%h2osno_old_col & ! Output: [real(r8) (:) ] snow water (mm H2O) at previous time step ) - if(use_aquifer_layer) then - do fc = 1, num_nolakec - c = filter_nolakec(fc) - if (col%hydrologically_active(c)) then - if(zwt(c) <= zi(c,nlevsoi)) then - wa(c) = aquifer_water_baseline - end if - end if - end do - endif + ! wa(c) gets added to liquid_mass in ComputeLiqIceMassNonLake called here. + ! wa_reset_nonconservation_gain is calculated for the grid cell-level + ! water balance check and may be non-zero only when + ! use_aquifer_layer is true. The grid cell-level balance check ensures + ! that this term is zero when use_aquifer_layer is false, as it should be. + ! In particular, we adjust wa back to the baseline under certain + ! conditions. The right way to do this might be to use explicit fluxes from + ! some other state, but in this case we don't have a source to pull from, + ! so we adjust wa without explicit fluxes. Because we do this before + ! initializing the column-level balance check, the column-level check is + ! unaware of the adjustment. However, since this adjustment happens after + ! initializing the gridcell-level balance check, we have to account for + ! it in the gridcell-level balance check. The normal way to account for an + ! adjustment like this would be to include the flux in the balance check. + ! Here we don't have an explicit flux, so instead we track the + ! non-conservation state. In principle, we could calculate an explicit flux + ! and use that, but we don't gain anything from using an explicit flux in + ! this case. + if(use_aquifer_layer) then + do fc = 1, num_nolakec + c = filter_nolakec(fc) + if (col%hydrologically_active(c)) then + if(zwt(c) <= zi(c,nlevsoi)) then + wa_reset_nonconservation_gain(c) = aquifer_water_baseline - & + wa(c) + wa(c) = aquifer_water_baseline + else + wa_reset_nonconservation_gain(c) = 0._r8 + end if + end if + end do + endif call ComputeWaterMassNonLake(bounds, num_nolakec, filter_nolakec, & waterstate_inst, waterdiagnostic_inst, & @@ -228,14 +422,14 @@ subroutine BeginWaterBalanceSingle(bounds, & end associate - end subroutine BeginWaterBalanceSingle + end subroutine BeginWaterColumnBalanceSingle !----------------------------------------------------------------------- subroutine BalanceCheck( bounds, & num_allc, filter_allc, & atm2lnd_inst, solarabs_inst, waterflux_inst, waterstate_inst, & waterdiagnosticbulk_inst, waterbalance_inst, wateratm2lnd_inst, & - surfalb_inst, energyflux_inst, canopystate_inst) + waterlnd2atm_inst, surfalb_inst, energyflux_inst, canopystate_inst) ! ! !DESCRIPTION: ! This subroutine accumulates the numerical truncation errors of the water @@ -253,11 +447,13 @@ subroutine BalanceCheck( bounds, & ! ! !USES: use clm_varcon , only : spval + use clm_varctl , only : use_soil_moisture_streams use clm_time_manager , only : get_step_size_real, get_nstep use clm_time_manager , only : get_nstep_since_startup_or_lastDA_restart_or_pause use CanopyStateType , only : canopystate_type + use subgridAveMod , only : c2g + use dynSubgridControlMod, only : get_for_testing_zero_dynbal_fluxes use SurfaceAlbedoType , only : surfalb_type - use subgridAveMod ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -269,6 +465,7 @@ subroutine BalanceCheck( bounds, & class(waterstate_type), intent(in) :: waterstate_inst type(waterdiagnosticbulk_type), intent(in) :: waterdiagnosticbulk_inst class(waterbalance_type), intent(inout) :: waterbalance_inst + class(waterlnd2atm_type), intent(in) :: waterlnd2atm_inst class(wateratm2lnd_type) , intent(in) :: wateratm2lnd_inst type(surfalb_type) , intent(in) :: surfalb_inst type(energyflux_type) , intent(inout) :: energyflux_inst @@ -280,9 +477,13 @@ subroutine BalanceCheck( bounds, & integer :: nstep ! time step number integer :: DAnstep ! time step number since last Data Assimilation (DA) integer :: indexp,indexc,indexl,indexg ! index of first found in search loop + real(r8) :: errh2o_grc(bounds%begg:bounds%endg) ! grid cell level water conservation error [mm H2O] 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] real(r8) :: h2osno_total(bounds%begc:bounds%endc) ! total snow water [mm H2O] + real(r8) :: qflx_glcice_dyn_water_flux_grc(bounds%begg:bounds%endg) ! grid cell-level water flux needed for balance check due to glc_dyn_runoff_routing [mm H2O/s] (positive means addition of water to the system) + real(r8) :: qflx_snwcp_discarded_liq_grc(bounds%begg:bounds%endg) ! grid cell-level excess liquid h2o due to snow capping, which we simply discard in order to reset the snow pack [mm H2O /s] + real(r8) :: qflx_snwcp_discarded_ice_grc(bounds%begg:bounds%endg) ! grid cell-level excess solid h2o due to snow capping, which we simply discard in order to reset the snow pack [mm H2O /s] real(r8) :: errh2o_max_val ! Maximum value of error in water conservation error over all columns [mm H2O] real(r8) :: errh2osno_max_val ! Maximum value of error in h2osno conservation error over all columns [kg m-2] @@ -300,27 +501,32 @@ subroutine BalanceCheck( bounds, & associate( & 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 => wateratm2lnd_inst%forc_rain_downscaled_col , & ! Input: [real(r8) (:) ] rain rate [mm/s] - forc_snow => wateratm2lnd_inst%forc_snow_downscaled_col , & ! Input: [real(r8) (:) ] snow rate [mm/s] + forc_rain => wateratm2lnd_inst%forc_rain_downscaled_col , & ! Input: [real(r8) (:) ] column level rain rate [mm/s] + forc_rain_grc => wateratm2lnd_inst%forc_rain_not_downscaled_grc, & ! Input: [real(r8) (:) ] grid cell-level rain rate [mm/s] + forc_snow => wateratm2lnd_inst%forc_snow_downscaled_col , & ! Input: [real(r8) (:) ] column level snow rate [mm/s] + forc_snow_grc => wateratm2lnd_inst%forc_snow_not_downscaled_grc, & ! Input: [real(r8) (:) ] grid cell-level snow rate [mm/s] forc_lwrad => atm2lnd_inst%forc_lwrad_downscaled_col , & ! Input: [real(r8) (:) ] downward infrared (longwave) radiation (W/m**2) h2osno_old => waterbalance_inst%h2osno_old_col , & ! Input: [real(r8) (:) ] snow water (mm H2O) at previous time step frac_sno_eff => waterdiagnosticbulk_inst%frac_sno_eff_col , & ! Input: [real(r8) (:) ] effective snow fraction frac_sno => waterdiagnosticbulk_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) snow_depth => waterdiagnosticbulk_inst%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) - begwb => waterbalance_inst%begwb_col , & ! Input: [real(r8) (:) ] water mass begining of the time step - errh2o => waterbalance_inst%errh2o_col , & ! Output: [real(r8) (:) ] water conservation error (mm H2O) + begwb_grc => waterbalance_inst%begwb_grc , & ! Input: [real(r8) (:) ] grid cell-level water mass begining of the time step + endwb_grc => waterbalance_inst%endwb_grc , & ! Output: [real(r8) (:) ] grid cell-level water mass end of the time step + begwb_col => waterbalance_inst%begwb_col , & ! Input: [real(r8) (:) ] column-level water mass begining of the time step + endwb_col => waterbalance_inst%endwb_col , & ! Output: [real(r8) (:) ] column-level water mass end of the time step + errh2o_col => waterbalance_inst%errh2o_col , & ! Output: [real(r8) (:) ] column-level water conservation error (mm H2O) errh2osno => waterbalance_inst%errh2osno_col , & ! Output: [real(r8) (:) ] error in h2osno (kg m-2) - endwb => waterbalance_inst%endwb_col , & ! Output: [real(r8) (:) ] water mass end of the time step snow_sources => waterbalance_inst%snow_sources_col , & ! Output: [real(r8) (:) ] snow sources (mm H2O /s) snow_sinks => waterbalance_inst%snow_sinks_col , & ! Output: [real(r8) (:) ] snow sinks (mm H2O /s) qflx_liq_grnd_col => waterflux_inst%qflx_liq_grnd_col , & ! Input: [real(r8) (:) ] liquid 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_snwcp_liq => waterflux_inst%qflx_snwcp_liq_col , & ! Input: [real(r8) (:) ] excess liquid h2o due to snow capping (outgoing) (mm H2O /s) [+]` qflx_snwcp_ice => waterflux_inst%qflx_snwcp_ice_col , & ! Input: [real(r8) (:) ] excess solid h2o due to snow capping (outgoing) (mm H2O /s) [+]` - qflx_snwcp_discarded_liq => waterflux_inst%qflx_snwcp_discarded_liq_col, & ! Input: [real(r8) (:) ] excess liquid h2o due to snow capping, which we simply discard in order to reset the snow pack (mm H2O /s) [+]` - qflx_snwcp_discarded_ice => waterflux_inst%qflx_snwcp_discarded_ice_col, & ! Input: [real(r8) (:) ] excess solid h2o due to snow capping, which we simply discard in order to reset the snow pack (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_snwcp_discarded_liq_col => waterflux_inst%qflx_snwcp_discarded_liq_col, & ! Input: [real(r8) (:)] column level excess liquid h2o due to snow capping, which we simply discard in order to reset the snow pack (mm H2O /s) [+] + qflx_snwcp_discarded_ice_col => waterflux_inst%qflx_snwcp_discarded_ice_col, & ! Input: [real(r8) (:)] column level excess solid h2o due to snow capping, which we simply discard in order to reset the snow pack (mm H2O /s) [+] + qflx_evap_tot_col => waterflux_inst%qflx_evap_tot_col , & ! Input: [real(r8) (:) ] column level qflx_evap_soi + qflx_evap_can + qflx_tran_veg + qflx_evap_tot_grc => waterlnd2atm_inst%qflx_evap_tot_grc , & ! Input: [real(r8) (:) ] grid cell-level qflx_evap_soi + qflx_evap_can + qflx_tran_veg qflx_soliddew_to_top_layer => waterflux_inst%qflx_soliddew_to_top_layer_col , & ! Input: [real(r8) (:) ] rate of solid water deposited on top soil or snow layer (frost) (mm H2O /s) [+] qflx_solidevap_from_top_layer => waterflux_inst%qflx_solidevap_from_top_layer_col, & ! Input: [real(r8) (:) ] rate of ice evaporated from top soil or snow layer (sublimation) (mm H2O /s) [+] qflx_liqevap_from_top_layer => waterflux_inst%qflx_liqevap_from_top_layer_col , & ! Input: [real(r8) (:) ] rate of liquid water evaporated from top soil or snow layer (mm H2O/s) [+] @@ -328,18 +534,24 @@ subroutine BalanceCheck( bounds, & qflx_prec_grnd => waterdiagnosticbulk_inst%qflx_prec_grnd_col, & ! Input: [real(r8) (:) ] water onto ground including canopy runoff [kg/(m2 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_drain_perched_col => waterflux_inst%qflx_drain_perched_col , & ! Input: [real(r8) (:) ] column level sub-surface runoff (mm H2O /s) + qflx_drain_perched_grc => waterlnd2atm_inst%qflx_rofliq_drain_perched_grc, & ! Input: [real(r8) (:)] grid cell-level sub-surface runoff (mm H2O /s) + qflx_flood_col => waterflux_inst%qflx_floodc_col , & ! Input: [real(r8) (:) ] column level total runoff due to flooding + forc_flood_grc => wateratm2lnd_inst%forc_flood_grc , & ! Input: [real(r8) (:) ] grid cell-level total grid cell-level runoff from river model 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_ice_runoff_snwcp => waterflux_inst%qflx_ice_runoff_snwcp_col, & ! Input: [real(r8) (:) ] solid runoff from snow capping (mm H2O /s) - qflx_ice_runoff_xs => waterflux_inst%qflx_ice_runoff_xs_col , & ! Input: [real(r8) (:) ] solid runoff from excess ice in soil (mm H2O /s) + qflx_surf_col => waterflux_inst%qflx_surf_col , & ! Input: [real(r8) (:) ] column level surface runoff (mm H2O /s) + qflx_surf_grc => waterlnd2atm_inst%qflx_rofliq_qsur_grc , & ! Input: [real(r8) (:) ] grid cell-level surface runoff (mm H20 /s) + qflx_qrgwl_col => waterflux_inst%qflx_qrgwl_col , & ! Input: [real(r8) (:) ] column level qflx_surf at glaciers, wetlands, lakes + qflx_qrgwl_grc => waterlnd2atm_inst%qflx_rofliq_qgwl_grc , & ! Input: [real(r8) (:) ] grid cell-level qflx_surf at glaciers, wetlands, lakes + qflx_drain_col => waterflux_inst%qflx_drain_col , & ! Input: [real(r8) (:) ] column level sub-surface runoff (mm H2O /s) + qflx_drain_grc => waterlnd2atm_inst%qflx_rofliq_qsub_grc , & ! Input: [real(r8) (:) ] grid cell-level drainage (mm H20 /s) + qflx_ice_runoff_col => waterlnd2atm_inst%qflx_ice_runoff_col , & ! Input: [real(r8) (:) ] column level solid runoff from snow capping and from excess ice in soil (mm H2O /s) + qflx_ice_runoff_grc => waterlnd2atm_inst%qflx_rofice_grc , & ! Input: [real(r8) (:) ] grid cell-level solid runoff from snow capping and from excess ice in soil (mm H2O /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_sfc_irrig => waterflux_inst%qflx_sfc_irrig_col , & ! Input: [real(r8) (:) ] irrigation flux (mm H2O /s) - qflx_glcice_dyn_water_flux => waterflux_inst%qflx_glcice_dyn_water_flux_col, & ! Input: [real(r8) (:)] water flux needed for balance check due to glc_dyn_runoff_routing (mm H2O/s) (positive means addition of water to the system) + qflx_sfc_irrig_col => waterflux_inst%qflx_sfc_irrig_col , & ! Input: [real(r8) (:) ] column level irrigation flux (mm H2O /s) + qflx_sfc_irrig_grc => waterlnd2atm_inst%qirrig_grc , & ! Input: [real(r8) (:) ] grid cell-level irrigation flux (mm H20 /s) + qflx_glcice_dyn_water_flux_col => waterflux_inst%qflx_glcice_dyn_water_flux_col, & ! Input: [real(r8) (:)] column level water flux needed for balance check due to glc_dyn_runoff_routing (mm H2O/s) (positive means addition of water to the system) dhsdt_canopy => energyflux_inst%dhsdt_canopy_patch , & ! Input: [real(r8) (:) ] change in heat content of canopy (W/m**2) [+ to atm] eflx_lwrad_out => energyflux_inst%eflx_lwrad_out_patch , & ! Input: [real(r8) (:) ] emitted infrared (longwave) radiation (W/m**2) @@ -400,87 +612,160 @@ subroutine BalanceCheck( bounds, & end if end do - ! Water balance check + ! Water balance check at the column level do c = bounds%begc, bounds%endc ! add qflx_drain_perched and qflx_flood if (col%active(c)) then - errh2o(c) = endwb(c) - begwb(c) & + errh2o_col(c) = endwb_col(c) - begwb_col(c) & - (forc_rain_col(c) & + forc_snow_col(c) & - + qflx_floodc(c) & - + qflx_sfc_irrig(c) & - + qflx_glcice_dyn_water_flux(c) & - - qflx_evap_tot(c) & - - qflx_surf(c) & - - qflx_qrgwl(c) & - - qflx_drain(c) & - - qflx_drain_perched(c) & - - qflx_ice_runoff_snwcp(c) & - - qflx_ice_runoff_xs(c) & - - qflx_snwcp_discarded_liq(c) & - - qflx_snwcp_discarded_ice(c)) * dtime + + qflx_flood_col(c) & + + qflx_sfc_irrig_col(c) & + + qflx_glcice_dyn_water_flux_col(c) & + - qflx_evap_tot_col(c) & + - qflx_surf_col(c) & + - qflx_qrgwl_col(c) & + - qflx_drain_col(c) & + - qflx_drain_perched_col(c) & + - qflx_ice_runoff_col(c) & + - qflx_snwcp_discarded_liq_col(c) & + - qflx_snwcp_discarded_ice_col(c)) * dtime else - errh2o(c) = 0.0_r8 + errh2o_col(c) = 0.0_r8 end if end do - errh2o_max_val = maxval(abs(errh2o(bounds%begc:bounds%endc))) + errh2o_max_val = maxval(abs(errh2o_col(bounds%begc:bounds%endc))) if (errh2o_max_val > h2o_warning_thresh) then - indexc = maxloc( abs(errh2o(bounds%begc:bounds%endc)), 1 ) + bounds%begc -1 - write(iulog,*)'WARNING: water balance error ',& + indexc = maxloc( abs(errh2o_col(bounds%begc:bounds%endc)), 1 ) + bounds%begc - 1 + write(iulog,*)'WARNING: column-level water balance error ',& ' nstep= ',nstep, & ' local indexc= ',indexc,& ! ' global indexc= ',GetGlobalIndex(decomp_index=indexc, clmlevel=namec), & - ' errh2o= ',errh2o(indexc) + ' errh2o= ',errh2o_col(indexc) if ((errh2o_max_val > error_thresh) .and. (DAnstep > skip_steps)) then - write(iulog,*)'clm urban model is stopping - error is greater than 1e-5 (mm)' + write(iulog,*)'CTSM is stopping because errh2o > ', error_thresh, ' mm' write(iulog,*)'nstep = ',nstep - write(iulog,*)'errh2o = ',errh2o(indexc) + write(iulog,*)'errh2o_col = ',errh2o_col(indexc) write(iulog,*)'forc_rain = ',forc_rain_col(indexc)*dtime write(iulog,*)'forc_snow = ',forc_snow_col(indexc)*dtime - write(iulog,*)'endwb = ',endwb(indexc) - write(iulog,*)'begwb = ',begwb(indexc) + write(iulog,*)'endwb_col = ',endwb_col(indexc) + write(iulog,*)'begwb_col = ',begwb_col(indexc) - write(iulog,*)'qflx_evap_tot = ',qflx_evap_tot(indexc)*dtime - write(iulog,*)'qflx_sfc_irrig = ',qflx_sfc_irrig(indexc)*dtime - write(iulog,*)'qflx_surf = ',qflx_surf(indexc)*dtime - write(iulog,*)'qflx_qrgwl = ',qflx_qrgwl(indexc)*dtime - write(iulog,*)'qflx_drain = ',qflx_drain(indexc)*dtime + write(iulog,*)'qflx_evap_tot = ',qflx_evap_tot_col(indexc)*dtime + write(iulog,*)'qflx_sfc_irrig = ',qflx_sfc_irrig_col(indexc)*dtime + write(iulog,*)'qflx_surf = ',qflx_surf_col(indexc)*dtime + write(iulog,*)'qflx_qrgwl = ',qflx_qrgwl_col(indexc)*dtime + write(iulog,*)'qflx_drain = ',qflx_drain_col(indexc)*dtime - write(iulog,*)'qflx_ice_runoff_snwcp = ',qflx_ice_runoff_snwcp(indexc)*dtime - write(iulog,*)'qflx_ice_runoff_xs = ',qflx_ice_runoff_xs(indexc)*dtime + write(iulog,*)'qflx_ice_runoff = ',qflx_ice_runoff_col(indexc)*dtime - write(iulog,*)'qflx_snwcp_discarded_ice = ',qflx_snwcp_discarded_ice(indexc)*dtime - write(iulog,*)'qflx_snwcp_discarded_liq = ',qflx_snwcp_discarded_liq(indexc)*dtime - write(iulog,*)'deltawb = ',endwb(indexc)-begwb(indexc) - write(iulog,*)'deltawb/dtime = ',(endwb(indexc)-begwb(indexc))/dtime + write(iulog,*)'qflx_snwcp_discarded_ice = ',qflx_snwcp_discarded_ice_col(indexc)*dtime + write(iulog,*)'qflx_snwcp_discarded_liq = ',qflx_snwcp_discarded_liq_col(indexc)*dtime + write(iulog,*)'deltawb = ',endwb_col(indexc)-begwb_col(indexc) + write(iulog,*)'deltawb/dtime = ',(endwb_col(indexc)-begwb_col(indexc))/dtime if (.not.(col%itype(indexc) == icol_roof .or. & col%itype(indexc) == icol_road_imperv .or. & col%itype(indexc) == icol_road_perv)) then - write(iulog,*)'qflx_drain_perched = ',qflx_drain_perched(indexc)*dtime - write(iulog,*)'qflx_flood = ',qflx_floodc(indexc)*dtime - write(iulog,*)'qflx_glcice_dyn_water_flux = ', qflx_glcice_dyn_water_flux(indexc)*dtime + write(iulog,*)'qflx_drain_perched = ',qflx_drain_perched_col(indexc)*dtime + write(iulog,*)'qflx_flood = ',qflx_flood_col(indexc)*dtime + write(iulog,*)'qflx_glcice_dyn_water_flux = ', qflx_glcice_dyn_water_flux_col(indexc)*dtime end if - write(iulog,*)'clm model is stopping' + write(iulog,*)'CTSM is stopping' call endrun(decomp_index=indexc, clmlevel=namec, msg=errmsg(sourcefile, __LINE__)) end if end if - ! Snow balance check + ! Water balance check at the grid cell level + + call c2g( bounds, & + qflx_glcice_dyn_water_flux_col(bounds%begc:bounds%endc), & + qflx_glcice_dyn_water_flux_grc(bounds%begg:bounds%endg), & + c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) + call c2g( bounds, & + qflx_snwcp_discarded_liq_col(bounds%begc:bounds%endc), & + qflx_snwcp_discarded_liq_grc(bounds%begg:bounds%endg), & + c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) + call c2g( bounds, & + qflx_snwcp_discarded_ice_col(bounds%begc:bounds%endc), & + qflx_snwcp_discarded_ice_grc(bounds%begg:bounds%endg), & + c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) + + do g = bounds%begg, bounds%endg + errh2o_grc(g) = endwb_grc(g) - begwb_grc(g) & + - (forc_rain_grc(g) & + + forc_snow_grc(g) & + + forc_flood_grc(g) & + + qflx_sfc_irrig_grc(g) & + + qflx_glcice_dyn_water_flux_grc(g) & + - qflx_evap_tot_grc(g) & + - qflx_surf_grc(g) & + - qflx_qrgwl_grc(g) & + - qflx_drain_grc(g) & + - qflx_drain_perched_grc(g) & + - qflx_ice_runoff_grc(g) & + - qflx_snwcp_discarded_liq_grc(g) & + - qflx_snwcp_discarded_ice_grc(g)) * dtime + end do + + errh2o_max_val = maxval(abs(errh2o_grc(bounds%begg:bounds%endg))) + + ! BUG(rgk, 2021-04-13, ESCOMP/CTSM#1314) Temporarily bypassing gridcell-level check with use_fates_planthydro until issue 1314 is resolved + + if (errh2o_max_val > h2o_warning_thresh .and. .not.use_fates_planthydro) then + + indexg = maxloc( abs(errh2o_grc(bounds%begg:bounds%endg)), 1 ) + bounds%begg - 1 + write(iulog,*)'WARNING: grid cell-level water balance error ',& + ' nstep= ',nstep, & + ' local indexg= ',indexg,& + ' errh2o_grc= ',errh2o_grc(indexg) + if (errh2o_max_val > error_thresh .and. DAnstep > skip_steps .and. & + .not. use_soil_moisture_streams .and. & + .not. get_for_testing_zero_dynbal_fluxes()) then + + write(iulog,*)'CTSM is stopping because errh2o > ', error_thresh, ' mm' + write(iulog,*)'nstep = ',nstep + write(iulog,*)'errh2o_grc = ',errh2o_grc(indexg) + write(iulog,*)'forc_rain = ',forc_rain_grc(indexg)*dtime + write(iulog,*)'forc_snow = ',forc_snow_grc(indexg)*dtime + write(iulog,*)'endwb_grc = ',endwb_grc(indexg) + write(iulog,*)'begwb_grc = ',begwb_grc(indexg) + + write(iulog,*)'qflx_evap_tot = ',qflx_evap_tot_grc(indexg)*dtime + write(iulog,*)'qflx_sfc_irrig = ',qflx_sfc_irrig_grc(indexg)*dtime + write(iulog,*)'qflx_surf = ',qflx_surf_grc(indexg)*dtime + write(iulog,*)'qflx_qrgwl = ',qflx_qrgwl_grc(indexg)*dtime + write(iulog,*)'qflx_drain = ',qflx_drain_grc(indexg)*dtime + write(iulog,*)'qflx_ice_runoff = ',qflx_ice_runoff_grc(indexg)*dtime + write(iulog,*)'qflx_snwcp_discarded_ice = ',qflx_snwcp_discarded_ice_grc(indexg)*dtime + write(iulog,*)'qflx_snwcp_discarded_liq = ',qflx_snwcp_discarded_liq_grc(indexg)*dtime + write(iulog,*)'deltawb = ',endwb_grc(indexg)-begwb_grc(indexg) + write(iulog,*)'deltawb/dtime = ',(endwb_grc(indexg)-begwb_grc(indexg))/dtime + write(iulog,*)'qflx_drain_perched = ',qflx_drain_perched_grc(indexg)*dtime + write(iulog,*)'forc_flood = ',forc_flood_grc(indexg)*dtime + write(iulog,*)'qflx_glcice_dyn_water_flux = ',qflx_glcice_dyn_water_flux_grc(indexg)*dtime + + write(iulog,*)'CTSM is stopping' + call endrun(decomp_index=indexg, clmlevel=nameg, msg=errmsg(sourcefile, __LINE__)) + end if + + end if + + ! Snow balance check at the column level. call waterstate_inst%CalculateTotalH2osno(bounds, num_allc, filter_allc, & caller = 'BalanceCheck', & @@ -501,7 +786,7 @@ subroutine BalanceCheck( bounds, & + qflx_liqdew_to_top_layer(c) snow_sinks(c) = qflx_solidevap_from_top_layer(c) + qflx_liqevap_from_top_layer(c) & + qflx_snow_drain(c) + qflx_snwcp_ice(c) + qflx_snwcp_liq(c) & - + qflx_snwcp_discarded_ice(c) + qflx_snwcp_discarded_liq(c) & + + qflx_snwcp_discarded_ice_col(c) + qflx_snwcp_discarded_liq_col(c) & + qflx_sl_top_soil(c) if (lun%itype(l) == istdlak) then @@ -510,20 +795,20 @@ subroutine BalanceCheck( bounds, & + qflx_soliddew_to_top_layer(c) + qflx_liqdew_to_top_layer(c) ) snow_sinks(c) = frac_sno_eff(c) * (qflx_solidevap_from_top_layer(c) & + qflx_liqevap_from_top_layer(c) ) + qflx_snwcp_ice(c) + qflx_snwcp_liq(c) & - + qflx_snwcp_discarded_ice(c) + qflx_snwcp_discarded_liq(c) & + + qflx_snwcp_discarded_ice_col(c) + qflx_snwcp_discarded_liq_col(c) & + qflx_snow_drain(c) + qflx_sl_top_soil(c) endif if (col%itype(c) == icol_road_perv .or. lun%itype(l) == istsoil .or. & lun%itype(l) == istcrop .or. lun%itype(l) == istwet .or. & - lun%itype(l) == istice_mec) then + lun%itype(l) == istice) then snow_sources(c) = (qflx_snow_grnd_col(c) - qflx_snow_h2osfc(c) ) & + frac_sno_eff(c) * (qflx_liq_grnd_col(c) & + qflx_soliddew_to_top_layer(c) + qflx_liqdew_to_top_layer(c) ) & + qflx_h2osfc_to_ice(c) snow_sinks(c) = frac_sno_eff(c) * (qflx_solidevap_from_top_layer(c) & + qflx_liqevap_from_top_layer(c)) + qflx_snwcp_ice(c) + qflx_snwcp_liq(c) & - + qflx_snwcp_discarded_ice(c) + qflx_snwcp_discarded_liq(c) & + + qflx_snwcp_discarded_ice_col(c) + qflx_snwcp_discarded_liq_col(c) & + qflx_snow_drain(c) + qflx_sl_top_soil(c) endif @@ -552,7 +837,7 @@ subroutine BalanceCheck( bounds, & ' errh2osno= ',errh2osno(indexc) if ((errh2osno_max_val > error_thresh) .and. (DAnstep > skip_steps) ) then - write(iulog,*)'clm model is stopping - error is greater than 1e-5 (mm)' + write(iulog,*)'CTSM is stopping because errh2osno > ', error_thresh, ' mm' write(iulog,*)'nstep = ',nstep write(iulog,*)'errh2osno = ',errh2osno(indexc) write(iulog,*)'snl = ',col%snl(indexc) @@ -572,10 +857,10 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'qflx_liqdew_to_top_layer = ',qflx_liqdew_to_top_layer(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_snwcp_discarded_ice = ',qflx_snwcp_discarded_ice(indexc)*dtime - write(iulog,*)'qflx_snwcp_discarded_liq = ',qflx_snwcp_discarded_liq(indexc)*dtime + write(iulog,*)'qflx_snwcp_discarded_ice = ',qflx_snwcp_discarded_ice_col(indexc)*dtime + write(iulog,*)'qflx_snwcp_discarded_liq = ',qflx_snwcp_discarded_liq_col(indexc)*dtime write(iulog,*)'qflx_sl_top_soil = ',qflx_sl_top_soil(indexc)*dtime - write(iulog,*)'clm model is stopping' + write(iulog,*)'CTSM is stopping' call endrun(decomp_index=indexc, clmlevel=namec, msg=errmsg(sourcefile, __LINE__)) end if @@ -647,7 +932,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'errsol = ',errsol(indexp) if (errsol_max_val > error_thresh) then - write(iulog,*)'clm model is stopping - error is greater than 1e-5 (W/m2)' + write(iulog,*)'CTSM is stopping because errsol > ', error_thresh, ' W/m2' write(iulog,*)'fsa = ',fsa(indexp) write(iulog,*)'fsr = ',fsr(indexp) write(iulog,*)'forc_solad(1) = ',forc_solad(indexg,1) @@ -656,7 +941,7 @@ subroutine BalanceCheck( bounds, & 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' + write(iulog,*)'CTSM is stopping' call endrun(decomp_index=indexp, clmlevel=namep, msg=errmsg(sourcefile, __LINE__)) end if @@ -673,7 +958,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'nstep = ',nstep write(iulog,*)'errlon = ',errlon(indexp) if (errlon_max_val > error_thresh ) then - write(iulog,*)'clm model is stopping - error is greater than 1e-5 (W/m2)' + write(iulog,*)'CTSM is stopping because errlon > ', error_thresh, ' W/m2' call endrun(decomp_index=indexp, clmlevel=namep, msg=errmsg(sourcefile, __LINE__)) end if end if @@ -693,7 +978,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'errseb = ' ,errseb(indexp) if ( errseb_max_val > error_thresh ) then - write(iulog,*)'clm model is stopping - error is greater than 1e-5 (W/m2)' + write(iulog,*)'CTSM is stopping because errseb > ', error_thresh, ' 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) @@ -710,7 +995,7 @@ subroutine BalanceCheck( bounds, & 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' + write(iulog,*)'CTSM is stopping' call endrun(decomp_index=indexp, clmlevel=namep, msg=errmsg(sourcefile, __LINE__)) end if @@ -727,7 +1012,7 @@ subroutine BalanceCheck( bounds, & write(iulog,*)'errsoi_col = ',errsoi_col(indexc) if ((errsoi_col_max_val > 1.e-4_r8) .and. (DAnstep > skip_steps)) then - write(iulog,*)'clm model is stopping' + write(iulog,*)'CTSM is stopping' call endrun(decomp_index=indexc, clmlevel=namec, msg=errmsg(sourcefile, __LINE__)) end if end if diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index 89893e3aa4..cc14091a26 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -202,8 +202,7 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & 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 => waterdiagnosticbulk_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) - qg_snow => waterdiagnosticbulk_inst%qg_snow_col , & ! Input: [real(r8) (:) ] specific humidity at snow surface [kg/kg] + qg_snow => waterdiagnosticbulk_inst%qg_snow_col , & ! Input: [real(r8) (:) ] specific humidity at snow surface [kg/kg] qg_soil => waterdiagnosticbulk_inst%qg_soil_col , & ! Input: [real(r8) (:) ] specific humidity at soil surface [kg/kg] qg_h2osfc => waterdiagnosticbulk_inst%qg_h2osfc_col , & ! Input: [real(r8) (:) ] specific humidity at h2osfc surface [kg/kg] qg => waterdiagnosticbulk_inst%qg_col , & ! Input: [real(r8) (:) ] specific humidity at ground surface [kg/kg] diff --git a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 index f533a62916..2aa56de927 100644 --- a/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 +++ b/src/biogeophys/BiogeophysPreFluxCalcsMod.F90 @@ -19,7 +19,7 @@ module BiogeophysPreFluxCalcsMod use clm_varctl , only : use_fates use pftconMod , only : pftcon use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall - use landunit_varcon , only : istsoil, istcrop, istice_mec + use landunit_varcon , only : istsoil, istcrop, istice use clm_varcon , only : hvap, hsub use CLMFatesInterfaceMod , only : hlm_fates_interface_type use atm2lndType , only : atm2lnd_type @@ -285,7 +285,7 @@ subroutine CalcInitialTemperatureAndEnergyVars(bounds, & ! 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_mec) then + if (lun%itype(l)==istice) then emg(c) = 0.97_r8 else emg(c) = (1._r8-frac_sno(c))*0.96_r8 + frac_sno(c)*0.97_r8 diff --git a/src/biogeophys/CanopyFluxesMod.F90 b/src/biogeophys/CanopyFluxesMod.F90 index 7c10d1be29..f18bde2e0e 100644 --- a/src/biogeophys/CanopyFluxesMod.F90 +++ b/src/biogeophys/CanopyFluxesMod.F90 @@ -228,7 +228,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, use clm_varcon , only : sb, cpair, hvap, vkc, grav, denice, c_to_b use clm_varcon , only : denh2o, tfrz, tlsai_crit, alpha_aero use clm_varcon , only : c14ratio - use clm_varcon , only : c_water, c_dry_biomass + use clm_varcon , only : c_water, c_dry_biomass, c_to_b use perf_mod , only : t_startf, t_stopf use QSatMod , only : QSat use CLMFatesInterfaceMod, only : hlm_fates_interface_type @@ -447,6 +447,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, is_shrub => pftcon%is_shrub , & ! Input: shrub patch or not dleaf => pftcon%dleaf , & ! Input: characteristic leaf dimension (m) dbh_param => pftcon%dbh , & ! Input: diameter at brest height (m) + slatop => pftcon%slatop , & ! SLA at top of canopy [m^2/gC] fbw => pftcon%fbw , & ! Input: fraction of biomass that is water nstem => pftcon%nstem , & ! Input: stem number density (#ind/m2) rstem_per_dbh => pftcon%rstem_per_dbh , & ! Input: stem resistance per stem diameter (s/m**2) @@ -728,14 +729,14 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, sa_stem(p) = 0.0 endif - ! cross-sectional area of stems - carea_stem = shr_const_pi * (dbh(p)*0.5)**2 - ! if using Satellite Phenology mode, calculate leaf and stem biomass if(.not. use_cn) then - ! boreal needleleaf lma*c2b ~ 0.25 kg dry mass/m2(leaf) - leaf_biomass(p) = 0.25_r8 * max(0.01_r8, sa_leaf(p)) & + ! 2gbiomass/gC * (1/SLA) * 1e-3 = kg dry mass/m2(leaf) + leaf_biomass(p) = (1.e-3_r8*c_to_b/slatop(patch%itype(p))) & + * max(0.01_r8, 0.5_r8*sa_leaf(p)) & / (1.-fbw(patch%itype(p))) + ! cross-sectional area of stems + carea_stem = shr_const_pi * (dbh(p)*0.5)**2 stem_biomass(p) = carea_stem * htop(p) * k_cyl_vol & * nstem(patch%itype(p)) * wood_density(patch%itype(p)) & /(1.-fbw(patch%itype(p))) @@ -1346,13 +1347,13 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, ! Test for convergence itlef = itlef+1 - num_iter(p) = itlef 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)) + num_iter(p) = itlef end do fnold = fn fn = 0 @@ -1549,16 +1550,16 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, 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). + ! Calculate ozone uptake. This needs to be done after rssun and rsshade are + ! computed by the Photosynthesis routine. The updated ozone uptake computed here + ! will be used in the next time step to calculate ozone stress for the next time + ! step's photosynthesis calculations. ! 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( & + call ozone_inst%CalcOzoneUptake( & 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), & @@ -1567,7 +1568,7 @@ subroutine CanopyFluxes(bounds, num_exposedvegp, filter_exposedvegp, 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 diff --git a/src/biogeophys/FrictionVelocityMod.F90 b/src/biogeophys/FrictionVelocityMod.F90 index 9efd167879..6a9bb137c5 100644 --- a/src/biogeophys/FrictionVelocityMod.F90 +++ b/src/biogeophys/FrictionVelocityMod.F90 @@ -16,7 +16,7 @@ module FrictionVelocityMod use LandunitType , only : lun use ColumnType , only : col use PatchType , only : patch - use landunit_varcon , only : istsoil, istcrop, istice_mec, istwet + use landunit_varcon , only : istsoil, istcrop, istice, istwet use ncdio_pio , only : file_desc_t use paramUtilMod , only : readNcdioScalar use atm2lndType , only : atm2lnd_type @@ -564,7 +564,7 @@ subroutine SetRoughnessLengthsAndForcHeightsNonLake(this, bounds, & 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_mec) then + else if (lun%itype(l) == istwet .or. lun%itype(l) == istice) 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) diff --git a/src/biogeophys/GlacierSurfaceMassBalanceMod.F90 b/src/biogeophys/GlacierSurfaceMassBalanceMod.F90 index b6497fc4f2..de60eefb61 100644 --- a/src/biogeophys/GlacierSurfaceMassBalanceMod.F90 +++ b/src/biogeophys/GlacierSurfaceMassBalanceMod.F90 @@ -12,7 +12,7 @@ module GlacierSurfaceMassBalanceMod use clm_varpar , only : nlevgrnd use clm_varctl , only : glc_snow_persistence_max_days use clm_time_manager, only : get_step_size_real - use landunit_varcon, only : istice_mec + use landunit_varcon, only : istice use ColumnType , only : col use LandunitType , only : lun use glc2lndMod , only : glc2lnd_type @@ -127,7 +127,7 @@ subroutine HandleIceMelt(this, bounds, num_do_smb_c, filter_do_smb_c, & c = filter_do_smb_c(fc) l = col%landunit(c) - if (lun%itype(l) == istice_mec) then + if (lun%itype(l) == istice) then if (h2osoi_liq(c,j) > 0._r8) then ! ice layer with meltwater qflx_glcice_melt(c) = qflx_glcice_melt(c) + h2osoi_liq(c,j)/dtime @@ -135,7 +135,7 @@ subroutine HandleIceMelt(this, bounds, num_do_smb_c, filter_do_smb_c, & h2osoi_ice(c,j) = h2osoi_ice(c,j) + h2osoi_liq(c,j) h2osoi_liq(c,j) = 0._r8 end if ! liquid water is present - end if ! istice_mec + end if ! istice end do end do @@ -205,7 +205,7 @@ subroutine ComputeSurfaceMassBalance(this, bounds, num_allc, filter_allc, & 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 + .or. lun%itype(l) == istice) then qflx_glcice_frz(c) = qflx_snwcp_ice(c) else qflx_glcice_frz(c) = 0._r8 diff --git a/src/biogeophys/HydrologyDrainageMod.F90 b/src/biogeophys/HydrologyDrainageMod.F90 index 6a062e5d1c..4f9c549111 100644 --- a/src/biogeophys/HydrologyDrainageMod.F90 +++ b/src/biogeophys/HydrologyDrainageMod.F90 @@ -49,7 +49,7 @@ subroutine HydrologyDrainage(bounds, & ! Calculates soil/snow hydrology with drainage (subsurface runoff) ! ! !USES: - use landunit_varcon , only : istwet, istsoil, istice_mec, istcrop + use landunit_varcon , only : istwet, istsoil, istice, istcrop use column_varcon , only : icol_roof, icol_road_imperv, icol_road_perv, icol_sunwall, icol_shadewall use clm_varcon , only : denh2o, denice use clm_varctl , only : use_vichydro @@ -181,7 +181,7 @@ subroutine HydrologyDrainage(bounds, & l = col%landunit(c) g = col%gridcell(c) - if (lun%itype(l)==istwet .or. lun%itype(l)==istice_mec) then + if (lun%itype(l)==istwet .or. lun%itype(l)==istice) then qflx_drain(c) = 0._r8 qflx_drain_perched(c) = 0._r8 diff --git a/src/biogeophys/HydrologyNoDrainageMod.F90 b/src/biogeophys/HydrologyNoDrainageMod.F90 index 9a3009d968..279e15f0df 100644 --- a/src/biogeophys/HydrologyNoDrainageMod.F90 +++ b/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -245,11 +245,8 @@ subroutine HydrologyNoDrainage(bounds, & snowice => b_waterdiagnostic_inst%snowice_col , & ! Output: [real(r8) (:) ] average snow ice lens snowliq => b_waterdiagnostic_inst%snowliq_col , & ! Output: [real(r8) (:) ] average snow liquid water snow_persistence => b_waterstate_inst%snow_persistence_col , & ! Output: [real(r8) (:) ] counter for length of time snow-covered - h2osoi_liqice_10cm => b_waterdiagnostic_inst%h2osoi_liqice_10cm_col , & ! Output: [real(r8) (:) ] liquid water + ice lens in top 10cm of soil (kg/m2) h2osoi_ice => b_waterstate_inst%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) h2osoi_liq => b_waterstate_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) - h2osoi_ice_tot => b_waterdiagnostic_inst%h2osoi_ice_tot_col , & ! Output: [real(r8) (:) ] vertically summed ice lens (kg/m2) - h2osoi_liq_tot => b_waterdiagnostic_inst%h2osoi_liq_tot_col , & ! Output: [real(r8) (:) ] vertically summed liquid water (kg/m2) h2osoi_vol => b_waterstate_inst%h2osoi_vol_col , & ! Output: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] h2osno_top => b_waterdiagnostic_inst%h2osno_top_col , & ! Output: [real(r8) (:) ] mass of snow in top layer (col) [kg] wf => b_waterdiagnostic_inst%wf_col , & ! Output: [real(r8) (:) ] soil water as frac. of whc for top 0.05 m @@ -357,9 +354,9 @@ subroutine HydrologyNoDrainage(bounds, & end if if (use_aquifer_layer()) then - call WaterTable(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & + call WaterTable(bounds, num_hydrologyc, filter_hydrologyc, & soilhydrology_inst, soilstate_inst, temperature_inst, b_waterstate_inst, & - b_waterdiagnostic_inst, b_waterflux_inst) + b_waterflux_inst) else call PerchedWaterTable(bounds, num_hydrologyc, filter_hydrologyc, & @@ -370,12 +367,12 @@ subroutine HydrologyNoDrainage(bounds, & num_urbanc, filter_urbanc, soilhydrology_inst, soilstate_inst, & b_waterstate_inst, b_waterflux_inst) - call RenewCondensation(bounds, num_hydrologyc, filter_hydrologyc, & - num_urbanc, filter_urbanc,& - soilhydrology_inst, soilstate_inst, & - b_waterstate_inst, b_waterdiagnostic_inst, b_waterflux_inst) - - endif + end if + + call RenewCondensation(bounds, num_hydrologyc, filter_hydrologyc, & + num_urbanc, filter_urbanc,& + soilhydrology_inst, soilstate_inst, & + b_waterstate_inst, b_waterdiagnostic_inst, b_waterflux_inst) ! BUG(wjs, 2019-09-16, ESCOMP/ctsm#762) This is needed so that we can test the ! tracerization of the following snow stuff without having tracerized everything @@ -511,9 +508,6 @@ subroutine HydrologyNoDrainage(bounds, & if (.not. lun%urbpoi(l)) then t_soi_10cm(c) = 0._r8 tsoi17(c) = 0._r8 - h2osoi_liqice_10cm(c) = 0._r8 - h2osoi_liq_tot(c) = 0._r8 - h2osoi_ice_tot(c) = 0._r8 end if end do do j = 1, nlevsoi @@ -538,22 +532,13 @@ subroutine HydrologyNoDrainage(bounds, & 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 - h2osoi_liq_tot(c) = h2osoi_liq_tot(c) + h2osoi_liq(c,j) - h2osoi_ice_tot(c) = h2osoi_ice_tot(c) + h2osoi_ice(c,j) - end if end do end do diff --git a/src/biogeophys/LunaMod.F90 b/src/biogeophys/LunaMod.F90 index e32e7b2734..bd4fdfb4b0 100644 --- a/src/biogeophys/LunaMod.F90 +++ b/src/biogeophys/LunaMod.F90 @@ -833,7 +833,6 @@ subroutine NitrogenAllocation(FNCa,forc_pbot10, relh10, CO2a10,O2a10, PARi10,PAR 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) diff --git a/src/biogeophys/OzoneBaseMod.F90 b/src/biogeophys/OzoneBaseMod.F90 index c50818f380..a93a22f4eb 100644 --- a/src/biogeophys/OzoneBaseMod.F90 +++ b/src/biogeophys/OzoneBaseMod.F90 @@ -31,6 +31,7 @@ module OzoneBaseMod ! The following routines need to be implemented by all type extensions procedure(Init_interface) , public, deferred :: Init procedure(Restart_interface) , public, deferred :: Restart + procedure(CalcOzoneUptake_interface) , public, deferred :: CalcOzoneUptake procedure(CalcOzoneStress_interface) , public, deferred :: CalcOzoneStress ! The following routines should only be called by extensions of the ozone_base_type @@ -59,8 +60,8 @@ subroutine Restart_interface(this, bounds, ncid, flag) 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, & + + subroutine CalcOzoneUptake_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 @@ -77,8 +78,17 @@ subroutine CalcOzoneStress_interface(this, bounds, num_exposedvegp, filter_expos 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 subroutine CalcOzoneUptake_interface + + subroutine CalcOzoneStress_interface(this, bounds, num_exposedvegp, filter_exposedvegp) + use decompMod, only : bounds_type + 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 + end subroutine CalcOzoneStress_interface end interface contains diff --git a/src/biogeophys/OzoneFactoryMod.F90 b/src/biogeophys/OzoneFactoryMod.F90 index 2b28587a99..fa68b31851 100644 --- a/src/biogeophys/OzoneFactoryMod.F90 +++ b/src/biogeophys/OzoneFactoryMod.F90 @@ -41,9 +41,9 @@ function create_and_init_ozone_type(bounds) result(ozone) !----------------------------------------------------------------------- if (use_ozone) then - allocate(ozone, source = ozone_type()) + allocate(ozone_type :: ozone) else - allocate(ozone, source = ozone_off_type()) + allocate(ozone_off_type :: ozone) end if call ozone%Init(bounds) diff --git a/src/biogeophys/OzoneMod.F90 b/src/biogeophys/OzoneMod.F90 index 82c012a815..8e3a5d0dc2 100644 --- a/src/biogeophys/OzoneMod.F90 +++ b/src/biogeophys/OzoneMod.F90 @@ -9,15 +9,20 @@ module OzoneMod ! 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. + ! Developed by Danica Lombardozzi: Lombardozzi, D., S. Levis, G. Bonan, P. G. Hess, and + ! J. P. Sparks (2015), The Influence of Chronic Ozone Exposure on Global Carbon and + ! Water Cycles, J Climate, 28(1), 292–305, doi:10.1175/JCLI-D-14-00223.1. ! ! !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 clm_varctl , only : iulog use OzoneBaseMod, only : ozone_base_type use abortutils , only : endrun + use PatchType , only : patch + use pftconMod , only : pftcon implicit none save @@ -27,6 +32,8 @@ module OzoneMod type, extends(ozone_base_type), public :: ozone_type private ! Private data members + integer :: stress_method ! Which ozone stress parameterization we're using in this run + 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) @@ -52,6 +59,7 @@ module OzoneMod ! Public routines procedure, public :: Init procedure, public :: Restart + procedure, public :: CalcOzoneUptake procedure, public :: CalcOzoneStress ! Private routines @@ -59,15 +67,18 @@ module OzoneMod procedure, private :: InitHistory procedure, private :: InitCold + ! Calculate ozone uptake for a single point, for just sunlit or shaded leaves + procedure, private, nopass :: CalcOzoneUptakeOnePoint + + ! Original ozone stress parameterization, from Danica Lombardozzi 2015 + procedure, private :: CalcOzoneStressLombardozzi2015 + ! Calculate ozone stress for a single point, for just sunlit or shaded leaves - procedure, private, nopass :: CalcOzoneStressOnePoint + procedure, private, nopass :: CalcOzoneStressLombardozzi2015OnePoint end type ozone_type - interface ozone_type - module procedure constructor - end interface ozone_type - ! !PRIVATE TYPES: + integer, parameter :: stress_method_lombardozzi2015 = 1 ! TODO(wjs, 2014-09-29) This parameter will eventually become a spatially-varying ! value, obtained from ATM @@ -111,31 +122,6 @@ module OzoneMod ! 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) ! @@ -147,6 +133,9 @@ subroutine Init(this, bounds) type(bounds_type), intent(in) :: bounds !----------------------------------------------------------------------- + ! TODO(wjs, 2021-02-06) This will be based on a namelist variable + this%stress_method = stress_method_lombardozzi2015 + call this%InitAllocate(bounds) call this%InitHistory(bounds) call this%InitCold(bounds) @@ -280,26 +269,6 @@ subroutine Restart(this, bounds, ncid, flag) 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 ! ======================================================================== @@ -307,14 +276,11 @@ end subroutine Restart ! ======================================================================== !----------------------------------------------------------------------- - subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp, & + subroutine CalcOzoneUptake(this, bounds, num_exposedvegp, filter_exposedvegp, & forc_pbot, forc_th, rssun, rssha, rb, ram, tlai) ! ! !DESCRIPTION: - ! Calculate ozone stress. - ! - ! !USES: - use PatchType , only : patch + ! Calculate ozone uptake. ! ! !ARGUMENTS: class(ozone_type) , intent(inout) :: this @@ -334,7 +300,7 @@ subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp, & integer :: p ! patch index integer :: c ! column index - character(len=*), parameter :: subname = 'CalcOzoneStress' + character(len=*), parameter :: subname = 'CalcOzoneUptake' !----------------------------------------------------------------------- ! Enforce expected array sizes @@ -347,10 +313,6 @@ subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp, & SHR_ASSERT_ALL_FL((ubound(tlai) == (/bounds%endp/)), sourcefile, __LINE__) associate( & - o3coefvsha => this%o3coefvsha_patch , & ! Output: [real(r8) (:)] ozone coef - o3coefvsun => this%o3coefvsun_patch , & ! Output: [real(r8) (:)] ozone coef - o3coefgsha => this%o3coefgsha_patch , & ! Output: [real(r8) (:)] ozone coef - o3coefgsun => this%o3coefgsun_patch , & ! Output: [real(r8) (:)] ozone coef o3uptakesha => this%o3uptakesha_patch , & ! Output: [real(r8) (:)] ozone dose o3uptakesun => this%o3uptakesun_patch , & ! Output: [real(r8) (:)] ozone dose tlai_old => this%tlai_old_patch & ! Output: [real(r8) (:)] tlai from last time step @@ -360,19 +322,19 @@ subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp, & p = filter_exposedvegp(fp) c = patch%column(p) - ! Ozone stress for shaded leaves - call CalcOzoneStressOnePoint( & + ! Ozone uptake for shaded leaves + call CalcOzoneUptakeOnePoint( & 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)) + o3uptake=o3uptakesha(p)) - ! Ozone stress for sunlit leaves - call CalcOzoneStressOnePoint( & + ! Ozone uptake for sunlit leaves + call CalcOzoneUptakeOnePoint( & 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)) + o3uptake=o3uptakesun(p)) tlai_old(p) = tlai(p) @@ -380,21 +342,20 @@ subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp, & end associate - end subroutine CalcOzoneStress + end subroutine CalcOzoneUptake !----------------------------------------------------------------------- - subroutine CalcOzoneStressOnePoint( & + subroutine CalcOzoneUptakeOnePoint( & forc_ozone, forc_pbot, forc_th, & rs, rb, ram, & tlai, tlai_old, pft_type, & - o3uptake, o3coefv, o3coefg) + o3uptake) ! ! !DESCRIPTION: - ! Calculates ozone stress for a single point, for just sunlit or shaded leaves + ! Calculates ozone uptake 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: @@ -408,8 +369,6 @@ subroutine CalcOzoneStressOnePoint( & 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) @@ -421,12 +380,8 @@ subroutine CalcOzoneStressOnePoint( & 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' + character(len=*), parameter :: subname = 'CalcOzoneUptakeOnePoint' !----------------------------------------------------------------------- ! convert o3 from mol/mol to nmol m^-3 @@ -435,7 +390,7 @@ subroutine CalcOzoneStressOnePoint( & ! calculate instantaneous flux o3flux = o3concnmolm3/ (ko3*rs+ rb + ram) - ! apply o3 flux threshold + ! apply o3 flux threshold if (o3flux < o3_flux_threshold) then o3fluxcrit = 0._r8 else @@ -472,6 +427,108 @@ subroutine CalcOzoneStressOnePoint( & o3uptake = 0._r8 end if + end subroutine CalcOzoneUptakeOnePoint + + !----------------------------------------------------------------------- + subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp) + ! + ! !DESCRIPTION: + ! Calculate ozone stress. + ! + ! !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 + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'CalcOzoneStress' + !----------------------------------------------------------------------- + + select case (this%stress_method) + case (stress_method_lombardozzi2015) + call this%CalcOzoneStressLombardozzi2015(bounds, num_exposedvegp, filter_exposedvegp) + case default + write(iulog,*) 'ERROR: unknown ozone stress method: ', this%stress_method + call endrun('Unknown ozone stress method') + end select + + end subroutine CalcOzoneStress + + !----------------------------------------------------------------------- + subroutine CalcOzoneStressLombardozzi2015(this, bounds, num_exposedvegp, filter_exposedvegp) + ! + ! !DESCRIPTION: + ! Calculate ozone stress. + ! + ! This subroutine uses the Lombardozzi2015 formulation for ozone stress + ! + ! !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 + ! + ! !LOCAL VARIABLES: + integer :: fp ! filter index + integer :: p ! patch index + + character(len=*), parameter :: subname = 'CalcOzoneStressLombardozzi2015' + !----------------------------------------------------------------------- + + associate( & + o3uptakesha => this%o3uptakesha_patch , & ! Input: [real(r8) (:)] ozone dose + o3uptakesun => this%o3uptakesun_patch , & ! Input: [real(r8) (:)] ozone dose + 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 + ) + + do fp = 1, num_exposedvegp + p = filter_exposedvegp(fp) + + ! Ozone stress for shaded leaves + call CalcOzoneStressLombardozzi2015OnePoint( & + pft_type=patch%itype(p), o3uptake=o3uptakesha(p), & + o3coefv=o3coefvsha(p), o3coefg=o3coefgsha(p)) + + ! Ozone stress for sunlit leaves + call CalcOzoneStressLombardozzi2015OnePoint( & + pft_type=patch%itype(p), o3uptake=o3uptakesun(p), & + o3coefv=o3coefvsun(p), o3coefg=o3coefgsun(p)) + end do + + + end associate + + end subroutine CalcOzoneStressLombardozzi2015 + + !----------------------------------------------------------------------- + subroutine CalcOzoneStressLombardozzi2015OnePoint( & + pft_type, o3uptake, & + o3coefv, o3coefg) + ! + ! !DESCRIPTION: + ! Calculates ozone stress for a single point, for just sunlit or shaded leaves + ! + ! This subroutine uses the Lombardozzi2015 formulation for ozone stress + ! + ! !ARGUMENTS: + integer , intent(in) :: pft_type ! vegetation type, for indexing into pftvarcon arrays + real(r8) , intent(in) :: 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: + 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 = 'CalcOzoneStressLombardozzi2015OnePoint' + !----------------------------------------------------------------------- if (o3uptake == 0._r8) then ! No o3 damage if no o3 uptake @@ -506,7 +563,6 @@ subroutine CalcOzoneStressOnePoint( & end if - end subroutine CalcOzoneStressOnePoint - + end subroutine CalcOzoneStressLombardozzi2015OnePoint end module OzoneMod diff --git a/src/biogeophys/OzoneOffMod.F90 b/src/biogeophys/OzoneOffMod.F90 index ac5a946de9..f42707f667 100644 --- a/src/biogeophys/OzoneOffMod.F90 +++ b/src/biogeophys/OzoneOffMod.F90 @@ -22,6 +22,7 @@ module OzoneOffMod contains procedure, public :: Init procedure, public :: Restart + procedure, public :: CalcOzoneUptake procedure, public :: CalcOzoneStress end type ozone_off_type @@ -79,8 +80,8 @@ subroutine Restart(this, bounds, ncid, flag) end subroutine Restart - subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp, & - forc_pbot, forc_th, rssun, rssha, rb, ram, tlai) + subroutine CalcOzoneUptake(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 @@ -104,14 +105,17 @@ subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp, & SHR_ASSERT_ALL_FL((ubound(ram) == (/bounds%endp/)), sourcefile, __LINE__) SHR_ASSERT_ALL_FL((ubound(tlai) == (/bounds%endp/)), sourcefile, __LINE__) - ! Explicitly set outputs to 1. This isn't really needed, because they should still be - ! at 1 from cold-start initialization, but do this for clarity here. + ! Do nothing: In the ozone off case, we don't need to track ozone uptake - 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 CalcOzoneUptake + subroutine CalcOzoneStress(this, bounds, num_exposedvegp, filter_exposedvegp) + class(ozone_off_type), intent(inout) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_exposedvegp + integer , intent(in) :: filter_exposedvegp(:) + + ! Do nothing: Outputs (stress terms) are already fixed at 1 from cold start initialization end subroutine CalcOzoneStress end module OzoneOffMod diff --git a/src/biogeophys/PhotosynthesisMod.F90 b/src/biogeophys/PhotosynthesisMod.F90 index 44e28a681c..232485d8a1 100644 --- a/src/biogeophys/PhotosynthesisMod.F90 +++ b/src/biogeophys/PhotosynthesisMod.F90 @@ -950,7 +950,7 @@ subroutine TimeStepInit (this, bounds) ! Time step initialization ! ! !USES: - use landunit_varcon, only : istsoil, istcrop, istice_mec, istwet + use landunit_varcon, only : istsoil, istcrop, istice, istwet ! ! !ARGUMENTS: class(photosyns_type) :: this @@ -990,7 +990,7 @@ subroutine TimeStepInit (this, bounds) endif end if if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop & - .or. lun%itype(l) == istice_mec & + .or. lun%itype(l) == istice & .or. lun%itype(l) == istwet) then if (use_c13) then this%rc13_canair_patch(p) = 0._r8 @@ -3166,9 +3166,12 @@ subroutine PhotosynthesisHydraulicStress ( bounds, fn, filterp, & kp25_sha = kp25top * nscaler_sha ! Adjust for temperature - + ! Acclimation is done for Kattge 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) + ! These values are used for Leuning + !vcmaxse = 486.0_r8 + !jmaxse = 495.0_r8 tpuse = vcmaxse vcmaxc = fth25 (params_inst%vcmaxhd, vcmaxse) jmaxc = fth25 (params_inst%jmaxhd, jmaxse) diff --git a/src/biogeophys/SnowCoverFractionSwensonLawrence2012Mod.F90 b/src/biogeophys/SnowCoverFractionSwensonLawrence2012Mod.F90 index b165ac168e..f6a5ff41ee 100644 --- a/src/biogeophys/SnowCoverFractionSwensonLawrence2012Mod.F90 +++ b/src/biogeophys/SnowCoverFractionSwensonLawrence2012Mod.F90 @@ -21,7 +21,7 @@ module SnowCoverFractionSwensonLawrence2012Mod use clm_varcon , only : rpi use ColumnType , only : column_type use glcBehaviorMod , only : glc_behavior_type - use landunit_varcon, only : istice_mec + use landunit_varcon, only : istice use paramUtilMod , only : readNcdioScalar use SnowCoverFractionBaseMod, only : snow_cover_fraction_base_type @@ -454,8 +454,8 @@ subroutine SetDerivedParameters(this, bounds, col, glc_behavior, n_melt_coef, n_ do c = bounds%begc, bounds%endc g = col%gridcell(c) - if (col%lun_itype(c) == istice_mec .and. glc_behavior%allow_multiple_columns_grc(g)) then - ! ice_mec columns already account for subgrid topographic variability through + if (col%lun_itype(c) == istice .and. glc_behavior%allow_multiple_columns_grc(g)) then + ! ice columns already account for subgrid topographic variability through ! their use of multiple elevation classes; thus, to avoid double-accounting for ! topographic variability in these columns, we ignore topo_std and use a fixed ! value of n_melt. diff --git a/src/biogeophys/SnowHydrologyMod.F90 b/src/biogeophys/SnowHydrologyMod.F90 index 8d1824a70c..7127c899a8 100644 --- a/src/biogeophys/SnowHydrologyMod.F90 +++ b/src/biogeophys/SnowHydrologyMod.F90 @@ -36,7 +36,7 @@ module SnowHydrologyMod use LandunitType , only : landunit_type, lun use TopoMod, only : topo_type use ColumnType , only : column_type, col - use landunit_varcon , only : istsoil, istdlak, istsoil, istwet, istice_mec, istcrop + use landunit_varcon , only : istsoil, istdlak, istsoil, istwet, istice, istcrop use clm_time_manager, only : get_step_size_real, get_nstep use filterColMod , only : filter_col_type, col_filter_from_filter_and_logical_array use LakeCon , only : lsadz @@ -3406,12 +3406,12 @@ subroutine SnowCappingExcess(bounds, num_snowc, filter_snowc, & do fc = 1, num_snowc c = filter_snowc(fc) l = col%landunit(c) - if ((lun%itype(l) /= istice_mec) .and. & + if ((lun%itype(l) /= istice) .and. & reset_snow .and. & (h2osno(c) > reset_snow_h2osno)) then h2osno_excess(c) = h2osno(c) - reset_snow_h2osno apply_runoff(c) = .false. - else if ((lun%itype(l) == istice_mec) .and. & + else if ((lun%itype(l) == istice) .and. & reset_snow_glc .and. & (h2osno(c) > reset_snow_h2osno) .and. & (topo(c) <= reset_snow_glc_ela)) then @@ -3970,8 +3970,8 @@ subroutine SnowHydrologySetControlForTesting( set_winddep_snowdensity, set_new_s ! !ARGUMENTS: logical, intent(in), optional :: set_winddep_snowdensity ! Set wind dependent snow density integer, intent(in), optional :: set_new_snow_density ! snow density method - logical, intent(in), optional :: set_reset_snow ! whether to reset the snow pack, non-glc_mec points - logical, intent(in), optional :: set_reset_snow_glc ! whether to reset the snow pack, glc_mec points + logical, intent(in), optional :: set_reset_snow ! whether to reset the snow pack, non-glacier points + logical, intent(in), optional :: set_reset_snow_glc ! whether to reset the snow pack, glacier points real(r8), intent(in), optional :: set_reset_snow_glc_ela ! elevation below which to reset the snow pack if set_reset_snow_glc is true (m) !----------------------------------------------------------------------- if (present(set_winddep_snowdensity)) then diff --git a/src/biogeophys/SoilFluxesMod.F90 b/src/biogeophys/SoilFluxesMod.F90 index 10082db373..bb88042797 100644 --- a/src/biogeophys/SoilFluxesMod.F90 +++ b/src/biogeophys/SoilFluxesMod.F90 @@ -74,17 +74,12 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & 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 + real(r8) :: evaporation_limit ! top layer moisture available for evaporation + real(r8) :: evaporation_demand ! evaporative demand !----------------------------------------------------------------------- associate( & @@ -186,23 +181,8 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & 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 @@ -224,40 +204,46 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & 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 + ! Constrain evaporation from snow to be <= available moisture + do fp = 1,num_nolakep + p = filter_nolakep(fp) + c = patch%column(p) + j = col%snl(c)+1 + ! snow layers; assumes for j < 1 that frac_sno_eff > 0 + if (j < 1) then + ! Defining the limitation uniformly for all patches is more + ! strict than absolutely necessary. This definition assumes + ! each patch is spatially distinct and may remove all the snow + ! on its patch, but may not remove snow from adjacent patches. + evaporation_limit = (h2osoi_ice(c,j)+h2osoi_liq(c,j))/(frac_sno_eff(c)*dtime) + if (qflx_ev_snow(p) > evaporation_limit) then + evaporation_demand = qflx_ev_snow(p) + qflx_ev_snow(p) = evaporation_limit + qflx_evap_soi(p) = qflx_evap_soi(p) - frac_sno_eff(c)*(evaporation_demand - evaporation_limit) + ! conserve total energy flux + eflx_sh_grnd(p) = eflx_sh_grnd(p) + frac_sno_eff(c)*(evaporation_demand - evaporation_limit)*htvp(c) + endif + endif + + ! top soil layer for urban columns (excluding pervious road, which + ! shouldn't be limited here b/c it uses the uses the soilwater + ! equations, while the other urban columns do not) + if (lun%urbpoi(patch%landunit(p)) .and. (col%itype(c)/=icol_road_perv) .and. (j == 1)) then + evaporation_limit = (h2osoi_ice(c,j)+h2osoi_liq(c,j))/dtime + if (qflx_evap_soi(p) > evaporation_limit) then + evaporation_demand = qflx_evap_soi(p) + qflx_evap_soi(p) = evaporation_limit + qflx_ev_snow(p) = qflx_evap_soi(p) + ! conserve total energy flux + eflx_sh_grnd(p) = eflx_sh_grnd(p) +(evaporation_demand -evaporation_limit)*htvp(c) + endif + endif + + enddo + 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) @@ -265,23 +251,6 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & 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 - - ! Update ev_snow for urban landunits here - if (lun%urbpoi(l)) then - qflx_ev_snow(p) = qflx_evap_soi(p) - end if - ! Ground heat flux if (.not. lun%urbpoi(l)) then @@ -318,6 +287,7 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & eflx_sh_tot(p) = eflx_sh_veg(p) + eflx_sh_grnd(p) if (.not. lun%urbpoi(l)) eflx_sh_tot(p) = eflx_sh_tot(p) + eflx_sh_stem(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) @@ -386,6 +356,20 @@ subroutine SoilFluxes (bounds, num_urbanl, filter_urbanl, & end if + ! limit only solid evaporation (sublimation) from top soil layer + ! (liquid evaporation from soil should not be limited) + if (j==1 .and. frac_h2osfc(c) < 1._r8) then + evaporation_limit = h2osoi_ice(c,j)/(dtime*(1._r8 - frac_h2osfc(c))) + if (qflx_solidevap_from_top_layer(p) >= evaporation_limit) then + evaporation_demand = qflx_solidevap_from_top_layer(p) + qflx_solidevap_from_top_layer(p) & + = evaporation_limit + qflx_liqevap_from_top_layer(p) & + = qflx_liqevap_from_top_layer(p) & + + (evaporation_demand - evaporation_limit) + endif + endif + ! Variables needed by history tape qflx_evap_can(p) = qflx_evap_veg(p) - qflx_tran_veg(p) diff --git a/src/biogeophys/SoilHydrologyInitTimeConstMod.F90 b/src/biogeophys/SoilHydrologyInitTimeConstMod.F90 index 64ede52fc4..61b692ae37 100644 --- a/src/biogeophys/SoilHydrologyInitTimeConstMod.F90 +++ b/src/biogeophys/SoilHydrologyInitTimeConstMod.F90 @@ -45,7 +45,7 @@ subroutine SoilHydrologyInitTimeConst(bounds, soilhydrology_inst, soilstate_inst use clm_varpar , only : nlevsoi, nlevgrnd, nlayer, nlayert use clm_varcon , only : dzsoi, spval, nlvic, dzvic, pc, grlnd use clm_varcon , only : aquifer_water_baseline - use landunit_varcon , only : istwet, istdlak, istice_mec + use landunit_varcon , only : istwet, istdlak, istice use column_varcon , only : icol_shadewall, icol_road_perv, icol_road_imperv, icol_roof, icol_sunwall use fileutils , only : getfil use ncdio_pio , only : file_desc_t, ncd_io, ncd_pio_openfile, ncd_pio_closefile @@ -150,7 +150,7 @@ subroutine SoilHydrologyInitTimeConst(bounds, soilhydrology_inst, soilstate_inst l = col%landunit(c) if (lun%itype(l) /= istdlak) then ! soil columns of both urban and non-urban types - if (lun%itype(l)==istwet .or. lun%itype(l)==istice_mec) then + if (lun%itype(l)==istwet .or. lun%itype(l)==istice) 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 @@ -167,22 +167,6 @@ subroutine SoilHydrologyInitTimeConst(bounds, soilhydrology_inst, soilstate_inst end if 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) @@ -191,7 +175,6 @@ subroutine SoilHydrologyInitTimeConst(bounds, soilhydrology_inst, soilstate_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) diff --git a/src/biogeophys/SoilHydrologyMod.F90 b/src/biogeophys/SoilHydrologyMod.F90 index 436b35e1cf..817280c7f4 100644 --- a/src/biogeophys/SoilHydrologyMod.F90 +++ b/src/biogeophys/SoilHydrologyMod.F90 @@ -17,6 +17,7 @@ module SoilHydrologyMod use column_varcon , only : icol_road_imperv use landunit_varcon , only : istsoil, istcrop use clm_time_manager , only : get_step_size_real + use NumericsMod , only : truncate_small_values use EnergyFluxType , only : energyflux_type use InfiltrationExcessRunoffMod, only : infiltration_excess_runoff_type use SoilHydrologyType , only : soilhydrology_type @@ -65,7 +66,8 @@ module SoilHydrologyMod type(params_type), private :: params_inst !----------------------------------------------------------------------- - real(r8), private :: baseflow_scalar = 1.e-2_r8 + real(r8), private :: baseflow_scalar = 1.e-2_r8 + real(r8), parameter :: tolerance = 1.e-12_r8 ! tolerance for checking whether sublimation is greater than ice in top soil layer character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -570,8 +572,8 @@ subroutine UpdateUrbanPonding(bounds, num_urbanc, filter_urbanc, & end subroutine UpdateUrbanPonding !----------------------------------------------------------------------- - subroutine WaterTable(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & - soilhydrology_inst, soilstate_inst, temperature_inst, waterstatebulk_inst, waterdiagnosticbulk_inst, waterfluxbulk_inst) + subroutine WaterTable(bounds, num_hydrologyc, filter_hydrologyc, & + soilhydrology_inst, soilstate_inst, temperature_inst, waterstatebulk_inst, waterfluxbulk_inst) ! ! !DESCRIPTION: ! Calculate watertable, considering aquifer recharge but no drainage. @@ -583,14 +585,11 @@ subroutine WaterTable(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, fil ! !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(waterstatebulk_type) , intent(inout) :: waterstatebulk_inst - type(waterdiagnosticbulk_type) , intent(inout) :: waterdiagnosticbulk_inst type(waterfluxbulk_type) , intent(inout) :: waterfluxbulk_inst ! ! !LOCAL VARIABLES: @@ -632,8 +631,7 @@ subroutine WaterTable(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, fil !----------------------------------------------------------------------- associate( & - snl => col%snl , & ! Input: [integer (:) ] number of snow layers - dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) + 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) @@ -643,10 +641,7 @@ subroutine WaterTable(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, fil h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) h2osoi_vol => waterstatebulk_inst%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] - frac_h2osfc => waterdiagnosticbulk_inst%frac_h2osfc_col , & ! Input: [real(r8) (:) ] - qflx_liqdew_to_top_layer => waterfluxbulk_inst%qflx_liqdew_to_top_layer_col , & ! Input: [real(r8) (:) ] rate of liquid water deposited on top soil or snow layer (dew) (mm H2O /s) [+] - qflx_soliddew_to_top_layer => waterfluxbulk_inst%qflx_soliddew_to_top_layer_col, & ! Input: [real(r8) (:) ] rate of solid water deposited on top soil or snow layer (frost) (mm H2O /s) [+] qflx_ev_snow => waterfluxbulk_inst%qflx_ev_snow_col , & ! In/Out: [real(r8) (:) ] evaporation flux from snow (mm H2O/s) [+ to atm] 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) @@ -661,8 +656,7 @@ subroutine WaterTable(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, fil qcharge => soilhydrology_inst%qcharge_col , & ! Input: [real(r8) (:) ] aquifer recharge rate (mm/s) origflag => soilhydrology_inst%origflag , & ! Input: logical - qflx_solidevap_from_top_layer => waterfluxbulk_inst%qflx_solidevap_from_top_layer_col, & ! Output: [real(r8) (:) ] rate of ice evaporated from top soil or snow layer (sublimation) (mm H2O /s) [+] - qflx_drain => waterfluxbulk_inst%qflx_drain_col , & ! Output: [real(r8) (:) ] sub-surface runoff (mm H2O /s) + qflx_drain => waterfluxbulk_inst%qflx_drain_col , & ! Output: [real(r8) (:) ] sub-surface runoff (mm H2O /s) qflx_drain_perched => waterfluxbulk_inst%qflx_drain_perched_col , & ! Output: [real(r8) (:) ] perched wt sub-surface runoff (mm H2O /s) qflx_rsub_sat => waterfluxbulk_inst%qflx_rsub_sat_col & ! Output: [real(r8) (:) ] soil saturation excess [mm h2o/s] ) @@ -834,51 +828,6 @@ subroutine WaterTable(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, fil 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_liqdew_to_top_layer(c) * dtime - h2osoi_ice(c,1) = h2osoi_ice(c,1) + (1._r8 - frac_h2osfc(c))*qflx_soliddew_to_top_layer(c) * dtime - if (qflx_solidevap_from_top_layer(c)*dtime > h2osoi_ice(c,1)) then - qflx_solidevap_from_top_layer_save = qflx_solidevap_from_top_layer(c) - qflx_solidevap_from_top_layer(c) = h2osoi_ice(c,1)/dtime - qflx_ev_snow(c) = qflx_ev_snow(c) - (qflx_solidevap_from_top_layer_save & - - qflx_solidevap_from_top_layer(c)) - h2osoi_ice(c,1) = 0._r8 - else - h2osoi_ice(c,1) = h2osoi_ice(c,1) - (1._r8 - frac_h2osfc(c)) * qflx_solidevap_from_top_layer(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_liqdew_to_top_layer(c) * dtime - h2osoi_ice(c,1) = h2osoi_ice(c,1) + (qflx_soliddew_to_top_layer(c) * dtime) - if (qflx_solidevap_from_top_layer(c)*dtime > h2osoi_ice(c,1)) then - qflx_solidevap_from_top_layer_save = qflx_solidevap_from_top_layer(c) - qflx_solidevap_from_top_layer(c) = h2osoi_ice(c,1)/dtime - qflx_ev_snow(c) = qflx_ev_snow(c) - (qflx_solidevap_from_top_layer_save & - - qflx_solidevap_from_top_layer(c)) - h2osoi_ice(c,1) = 0._r8 - else - h2osoi_ice(c,1) = h2osoi_ice(c,1) - (qflx_solidevap_from_top_layer(c) * dtime) - end if - end if - end if - - end do - end associate end subroutine WaterTable @@ -2285,9 +2234,12 @@ subroutine RenewCondensation(bounds, num_hydrologyc, filter_hydrologyc, & type(waterfluxbulk_type) , intent(inout) :: waterfluxbulk_inst ! ! !LOCAL VARIABLES: - integer :: c,j,fc,i ! indices - real(r8) :: dtime ! land model time step (sec) - real(r8) :: qflx_solidevap_from_top_layer_save ! temporary + integer :: c ,j,fc,i ! indices + real(r8) :: dtime ! land model time step (sec) + real(r8) :: qflx_solidevap_from_top_layer_save ! temporary + integer :: num_modifiedc ! number of columns in filter_modifiedc + integer :: filter_modifiedc(bounds%endc-bounds%begc+1) ! column filter of points modified in this subroutine + real(r8) :: h2osoi_ice_before_evap(bounds%begc:bounds%endc) ! h2osoi_ice in layer 1 before applying solidevap !----------------------------------------------------------------------- associate( & @@ -2304,6 +2256,7 @@ subroutine RenewCondensation(bounds, num_hydrologyc, filter_hydrologyc, & ! Get time step dtime = get_step_size_real() + num_modifiedc = 0 do fc = 1, num_hydrologyc c = filter_hydrologyc(fc) @@ -2311,19 +2264,14 @@ subroutine RenewCondensation(bounds, num_hydrologyc, filter_hydrologyc, & ! Renew the ice and liquid mass due to condensation if (snl(c)+1 >= 1) then + num_modifiedc = num_modifiedc + 1 + filter_modifiedc(num_modifiedc) = c ! make consistent with how evap_grnd removed in infiltration h2osoi_liq(c,1) = h2osoi_liq(c,1) + (1._r8 - frac_h2osfc(c))*qflx_liqdew_to_top_layer(c) * dtime h2osoi_ice(c,1) = h2osoi_ice(c,1) + (1._r8 - frac_h2osfc(c))*qflx_soliddew_to_top_layer(c) * dtime - if (qflx_solidevap_from_top_layer(c)*dtime > h2osoi_ice(c,1)) then - qflx_solidevap_from_top_layer_save = qflx_solidevap_from_top_layer(c) - qflx_solidevap_from_top_layer(c) = h2osoi_ice(c,1)/dtime - qflx_ev_snow(c) = qflx_ev_snow(c) - (qflx_solidevap_from_top_layer_save & - - qflx_solidevap_from_top_layer(c)) - h2osoi_ice(c,1) = 0._r8 - else - h2osoi_ice(c,1) = h2osoi_ice(c,1) - (1._r8 - frac_h2osfc(c)) * qflx_solidevap_from_top_layer(c) * dtime - end if + h2osoi_ice_before_evap(c) = h2osoi_ice(c,1) + h2osoi_ice(c,1) = h2osoi_ice(c,1) - (1._r8 - frac_h2osfc(c)) * qflx_solidevap_from_top_layer(c) * dtime end if end do @@ -2335,23 +2283,41 @@ subroutine RenewCondensation(bounds, num_hydrologyc, filter_hydrologyc, & if (col%itype(c) == icol_roof .or. col%itype(c) == icol_road_imperv) then if (snl(c)+1 >= 1) then + num_modifiedc = num_modifiedc + 1 + filter_modifiedc(num_modifiedc) = c + h2osoi_liq(c,1) = h2osoi_liq(c,1) + qflx_liqdew_to_top_layer(c) * dtime h2osoi_ice(c,1) = h2osoi_ice(c,1) + (qflx_soliddew_to_top_layer(c) * dtime) - if (qflx_solidevap_from_top_layer(c)*dtime > h2osoi_ice(c,1)) then - qflx_solidevap_from_top_layer_save = qflx_solidevap_from_top_layer(c) - qflx_solidevap_from_top_layer(c) = h2osoi_ice(c,1)/dtime - qflx_ev_snow(c) = qflx_ev_snow(c) - (qflx_solidevap_from_top_layer_save & - - qflx_solidevap_from_top_layer(c)) - h2osoi_ice(c,1) = 0._r8 - else - h2osoi_ice(c,1) = h2osoi_ice(c,1) - (qflx_solidevap_from_top_layer(c) * dtime) - end if + h2osoi_ice_before_evap(c) = h2osoi_ice(c,1) + h2osoi_ice(c,1) = h2osoi_ice(c,1) - (qflx_solidevap_from_top_layer(c) * dtime) end if end if end do - end associate + call truncate_small_values( & + num_f = num_modifiedc, & + filter_f = filter_modifiedc, & + lb = bounds%begc, & + ub = bounds%endc, & + data_baseline = h2osoi_ice_before_evap(bounds%begc:bounds%endc), & + data = h2osoi_ice(bounds%begc:bounds%endc, 1), & + custom_rel_epsilon = tolerance) + + do fc = 1, num_modifiedc + c = filter_modifiedc(fc) + + if (h2osoi_ice(c,1) < 0._r8) then + write(iulog,*) "ERROR: In RenewCondensation, h2osoi_ice has gone significantly negative" + write(iulog,*) "c = ", c + write(iulog,*) "h2osoi_ice_before_evap = ", h2osoi_ice_before_evap(c) + write(iulog,*) "h2osoi_ice(c,1) = ", h2osoi_ice(c,1) + write(iulog,*) "qflx_solidevap_from_top_layer*dtime = ", qflx_solidevap_from_top_layer(c)*dtime + call endrun("In RenewCondensation, h2osoi_ice has gone significantly negative") + end if + end do + + end associate end subroutine RenewCondensation !#8 diff --git a/src/biogeophys/SoilHydrologyType.F90 b/src/biogeophys/SoilHydrologyType.F90 index 752fae220a..4dfca06811 100644 --- a/src/biogeophys/SoilHydrologyType.F90 +++ b/src/biogeophys/SoilHydrologyType.F90 @@ -86,7 +86,7 @@ subroutine Init(this, bounds, NLFilename, waterstatebulk_inst, use_aquifer_layer call this%ReadNL(NLFilename) call this%InitAllocate(bounds) - call this%InitHistory(bounds) + call this%InitHistory(bounds, use_aquifer_layer) call this%InitCold(bounds, waterstatebulk_inst, use_aquifer_layer) end subroutine Init @@ -150,7 +150,7 @@ subroutine InitAllocate(this, bounds) end subroutine InitAllocate !------------------------------------------------------------------------ - subroutine InitHistory(this, bounds) + subroutine InitHistory(this, bounds, use_aquifer_layer) ! ! !USES: use histFileMod , only : hist_addfld1d @@ -158,6 +158,7 @@ subroutine InitHistory(this, bounds) ! !ARGUMENTS: class(soilhydrology_type) :: this type(bounds_type), intent(in) :: bounds + logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run ! ! !LOCAL VARIABLES: integer :: begc, endc @@ -167,10 +168,12 @@ subroutine InitHistory(this, bounds) begc = bounds%begc; endc= bounds%endc begg = bounds%begg; endg= bounds%endg - this%qcharge_col(begc:endc) = spval - call hist_addfld1d (fname='QCHARGE', units='mm/s', & - avgflag='A', long_name='aquifer recharge rate (natural vegetated and crop landunits only)', & - ptr_col=this%qcharge_col, l2g_scale_type='veg') + if (use_aquifer_layer) then + this%qcharge_col(begc:endc) = spval + call hist_addfld1d (fname='QCHARGE', units='mm/s', & + avgflag='A', long_name='aquifer recharge rate (natural vegetated and crop landunits only)', & + ptr_col=this%qcharge_col, l2g_scale_type='veg') + end if this%num_substeps_col(begc:endc) = spval call hist_addfld1d (fname='NSUBSTEPS', units='unitless', & diff --git a/src/biogeophys/SoilMoistureStreamMod.F90 b/src/biogeophys/SoilMoistureStreamMod.F90 index 421d729f0b..eab6d26c02 100644 --- a/src/biogeophys/SoilMoistureStreamMod.F90 +++ b/src/biogeophys/SoilMoistureStreamMod.F90 @@ -23,8 +23,7 @@ module SoilMoistureStreamMod 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, inst_name - use clm_varctl , only : iulog, use_soil_moisture_streams + use clm_varctl , only : iulog, use_soil_moisture_streams, inst_name use clm_varcon , only : grlnd use controlMod , only : NLFilename use decompMod , only : gsMap_lnd2Dsoi_gdc2glo diff --git a/src/biogeophys/SoilStateInitTimeConstMod.F90 b/src/biogeophys/SoilStateInitTimeConstMod.F90 index e035a55403..ad2da3852f 100644 --- a/src/biogeophys/SoilStateInitTimeConstMod.F90 +++ b/src/biogeophys/SoilStateInitTimeConstMod.F90 @@ -163,7 +163,7 @@ subroutine SoilStateInitTimeConst(bounds, soilstate_inst, nlfilename) use clm_varcon , only : secspday, pc, mu, denh2o, denice, grlnd use clm_varctl , only : use_cn, use_lch4, use_fates use clm_varctl , only : iulog, fsurdat, paramfile, soil_layerstruct_predefined - use landunit_varcon , only : istdlak, istwet, istsoil, istcrop, istice_mec + use landunit_varcon , only : istdlak, istwet, istsoil, istcrop, istice use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall, icol_road_perv, icol_road_imperv use fileutils , only : getfil use organicFileMod , only : organicrd @@ -390,9 +390,9 @@ subroutine SoilStateInitTimeConst(bounds, soilstate_inst, nlfilename) g = col%gridcell(c) l = col%landunit(c) - ! istwet and istice_mec and + ! istwet and istice and ! urban roof, sunwall, shadewall properties set to special value - if (lun%itype(l)==istwet .or. lun%itype(l)==istice_mec .or. & + if (lun%itype(l)==istwet .or. lun%itype(l)==istice .or. & (lun%urbpoi(l) .and. col%itype(c) /= icol_road_perv .and. & col%itype(c) /= icol_road_imperv)) then diff --git a/src/biogeophys/SoilTemperatureMod.F90 b/src/biogeophys/SoilTemperatureMod.F90 index e8a6b0ef68..ba4432cba2 100644 --- a/src/biogeophys/SoilTemperatureMod.F90 +++ b/src/biogeophys/SoilTemperatureMod.F90 @@ -570,7 +570,7 @@ subroutine SoilThermProp (bounds, num_urbanc, filter_urbanc, num_nolakec, filter ! !USES: use clm_varpar , only : nlevsno, nlevgrnd, nlevurb, nlevsoi, nlevmaxurbgrnd use clm_varcon , only : denh2o, denice, tfrz, tkwat, tkice, tkair, cpice, cpliq, thk_bedrock, csol_bedrock - use landunit_varcon , only : istice_mec, istwet + use landunit_varcon , only : istice, istwet use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall, icol_road_perv, icol_road_imperv use clm_varctl , only : iulog ! @@ -649,7 +649,7 @@ subroutine SoilThermProp (bounds, num_urbanc, filter_urbanc, num_nolakec, filter l = col%landunit(c) ! This will include pervious road for all nlevgrnd layers and impervious road for j > nlev_improad - if ((lun%itype(l) /= istwet .and. lun%itype(l) /= istice_mec & + if ((lun%itype(l) /= istwet .and. lun%itype(l) /= istice & .and. col%itype(c) /= icol_sunwall .and. col%itype(c) /= icol_shadewall .and. & col%itype(c) /= icol_roof .and. col%itype(c) /= icol_road_imperv) .or. & (col%itype(c) == icol_road_imperv .and. j > nlev_improad(l))) then @@ -670,7 +670,7 @@ subroutine SoilThermProp (bounds, num_urbanc, filter_urbanc, num_nolakec, filter thk(c,j) = tkdry(c,j) endif if (j > nbedrock(c)) thk(c,j) = thk_bedrock - else if (lun%itype(l) == istice_mec) then + else if (lun%itype(l) == istice) then thk(c,j) = tkwat if (t_soisno(c,j) < tfrz) thk(c,j) = tkice else if (lun%itype(l) == istwet) then @@ -752,7 +752,7 @@ subroutine SoilThermProp (bounds, num_urbanc, filter_urbanc, num_nolakec, filter do fc = 1,num_nolakec c = filter_nolakec(fc) l = col%landunit(c) - if ((lun%itype(l) /= istwet .and. lun%itype(l) /= istice_mec & + if ((lun%itype(l) /= istwet .and. lun%itype(l) /= istice & .and. col%itype(c) /= icol_sunwall .and. col%itype(c) /= icol_shadewall .and. & col%itype(c) /= icol_roof .and. col%itype(c) /= icol_road_imperv) .or. & (col%itype(c) == icol_road_imperv .and. j > nlev_improad(l))) then @@ -761,7 +761,7 @@ subroutine SoilThermProp (bounds, num_urbanc, filter_urbanc, num_nolakec, filter else if (lun%itype(l) == istwet) then cv(c,j) = (h2osoi_ice(c,j)*cpice + h2osoi_liq(c,j)*cpliq) if (j > nbedrock(c)) cv(c,j) = csol_bedrock*dz(c,j) - else if (lun%itype(l) == istice_mec) then + else if (lun%itype(l) == istice) then cv(c,j) = (h2osoi_ice(c,j)*cpice + h2osoi_liq(c,j)*cpliq) endif enddo @@ -1059,7 +1059,7 @@ subroutine Phasechange_beta (bounds, num_nolakec, filter_nolakec, dhsdT, & 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 + use landunit_varcon , only : istsoil, istcrop, istice ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds diff --git a/src/biogeophys/SurfaceAlbedoMod.F90 b/src/biogeophys/SurfaceAlbedoMod.F90 index e8f557f9b3..1b6eb1888f 100644 --- a/src/biogeophys/SurfaceAlbedoMod.F90 +++ b/src/biogeophys/SurfaceAlbedoMod.F90 @@ -1062,7 +1062,7 @@ subroutine SoilAlbedo (bounds, & ! !USES: use clm_varpar , only : numrad use clm_varcon , only : tfrz - use landunit_varcon , only : istice_mec, istdlak + use landunit_varcon , only : istice, istdlak use LakeCon , only : lakepuddling ! ! !ARGUMENTS: @@ -1124,7 +1124,7 @@ subroutine SoilAlbedo (bounds, & !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_mec) then ! land ice + else if (lun%itype(l) == istice) then ! land ice ! changed from local variable to clm_type: !albsod = albice(ib) !albsoi = albsod diff --git a/src/biogeophys/SurfaceHumidityMod.F90 b/src/biogeophys/SurfaceHumidityMod.F90 index 425fd4c4cb..25018211a9 100644 --- a/src/biogeophys/SurfaceHumidityMod.F90 +++ b/src/biogeophys/SurfaceHumidityMod.F90 @@ -14,7 +14,7 @@ module SurfaceHumidityMod use clm_varcon , only : denh2o, denice, roverg, 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_mec, istwet, istsoil, istcrop + use landunit_varcon , only : istice, istwet, istsoil, istcrop use clm_varpar , only : nlevgrnd use atm2lndType , only : atm2lnd_type use SoilStateType , only : soilstate_type @@ -126,7 +126,7 @@ subroutine CalculateSurfaceHumidity(bounds, & ! Saturated vapor pressure, specific humidity and their derivatives ! at ground surface qred = 1._r8 - if (lun%itype(l)/=istwet .AND. lun%itype(l)/=istice_mec) then + if (lun%itype(l)/=istwet .AND. lun%itype(l)/=istice) 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) diff --git a/src/biogeophys/SurfaceResistanceMod.F90 b/src/biogeophys/SurfaceResistanceMod.F90 index 0c6c0d6142..9b04327252 100644 --- a/src/biogeophys/SurfaceResistanceMod.F90 +++ b/src/biogeophys/SurfaceResistanceMod.F90 @@ -250,7 +250,7 @@ subroutine calc_beta_leepielke1992(bounds, num_nolakec, filter_nolakec, & use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) use decompMod , only : bounds_type use clm_varcon , only : denh2o, denice - use landunit_varcon , only : istice_mec, istwet, istsoil, istcrop + use landunit_varcon , only : istice, 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 @@ -284,7 +284,7 @@ subroutine calc_beta_leepielke1992(bounds, num_nolakec, filter_nolakec, & do fc = 1,num_nolakec c = filter_nolakec(fc) l = col%landunit(c) - if (lun%itype(l)/=istwet .AND. lun%itype(l)/=istice_mec) then + if (lun%itype(l)/=istwet .AND. lun%itype(l)/=istice) 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)) @@ -347,7 +347,7 @@ subroutine calc_soil_resistance_sl14(bounds, num_nolakec, filter_nolakec, & use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) use decompMod , only : bounds_type use clm_varcon , only : denh2o, denice - use landunit_varcon , only : istice_mec, istwet, istsoil, istcrop + use landunit_varcon , only : istice, 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 @@ -386,7 +386,7 @@ subroutine calc_soil_resistance_sl14(bounds, num_nolakec, filter_nolakec, & do fc = 1,num_nolakec c = filter_nolakec(fc) l = col%landunit(c) - if (lun%itype(l)/=istwet .AND. lun%itype(l)/=istice_mec) then + if (lun%itype(l)/=istwet .AND. lun%itype(l)/=istice) then if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then vwc_liq = max(h2osoi_liq(c,1),1.0e-6_r8)/(dz(c,1)*denh2o) ! eff_porosity not calculated til SoilHydrology diff --git a/src/biogeophys/TemperatureType.F90 b/src/biogeophys/TemperatureType.F90 index 050c6513b0..979a180f24 100644 --- a/src/biogeophys/TemperatureType.F90 +++ b/src/biogeophys/TemperatureType.F90 @@ -56,6 +56,7 @@ module TemperatureType 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 :: soila10_patch (:) ! patch 10-day running mean of the soil layer 3 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 @@ -230,6 +231,7 @@ subroutine InitAllocate(this, bounds) 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%soila10_patch (begp:endp)) ; this%soila10_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 @@ -462,13 +464,16 @@ subroutine InitHistory(this, bounds, is_simple_buildtemp, is_prog_buildtemp ) call hist_addfld1d (fname='T10', units='K', & avgflag='A', long_name='10-day running mean of 2-m temperature', & ptr_patch=this%t_a10_patch, default='inactive') - - if (use_cn .and. use_crop )then - this%t_a5min_patch(begp:endp) = spval - call hist_addfld1d (fname='A5TMIN', units='K', & - avgflag='A', long_name='5-day running mean of min 2-m temperature', & - ptr_patch=this%t_a5min_patch, default='inactive') - end if + + this%soila10_patch(begp:endp) = spval + call hist_addfld1d (fname='SOIL10', units='K', & + avgflag='A', long_name='10-day running mean of 12cm layer soil', & + ptr_patch=this%soila10_patch, default='inactive') + + 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') if (use_cn .and. use_crop )then this%t_a10min_patch(begp:endp) = spval @@ -643,7 +648,7 @@ subroutine InitCold(this, bounds, & use shr_kind_mod , only : r8 => shr_kind_r8 use shr_const_mod , only : SHR_CONST_TKFRZ use clm_varcon , only : denice, denh2o, sb - use landunit_varcon, only : istwet, istsoil, istdlak, istice_mec + use landunit_varcon, only : istwet, istsoil, istdlak, istice 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 @@ -692,7 +697,7 @@ subroutine InitCold(this, bounds, & ! Below snow temperatures - nonlake points (lake points are set below) if (.not. lun%lakpoi(l)) then - if (lun%itype(l)==istice_mec) then + if (lun%itype(l)==istice) then this%t_soisno_col(c,1:nlevgrnd) = 250._r8 else if (lun%itype(l) == istwet) then @@ -1178,15 +1183,18 @@ subroutine InitAccBuffer (this, bounds) 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) + call init_accum_field (name='SOIL10', units='K', & + desc='10-day running mean of 3rd layer soil temp.', 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) if ( use_crop )then call init_accum_field (name='TDM10', units='K', & desc='10-day running mean of min 2-m temperature', accum_type='runmean', accum_period=-10, & subgrid_type='pft', numlev=1, init_value=SHR_CONST_TKFRZ) - call init_accum_field (name='TDM5', units='K', & - desc='5-day running mean of min 2-m temperature', accum_type='runmean', accum_period=-5, & - subgrid_type='pft', numlev=1, init_value=SHR_CONST_TKFRZ) end if if ( use_crop )then @@ -1263,13 +1271,17 @@ subroutine InitAccVars(this, bounds) call extract_accum_field ('T10', rbufslp, nstep) this%t_a10_patch(begp:endp) = rbufslp(begp:endp) + + call extract_accum_field ('SOIL10', rbufslp, nstep) + this%soila10_patch(begp:endp) = rbufslp(begp:endp) + call extract_accum_field ('TDM5', rbufslp, nstep) + this%t_a5min_patch(begp:endp) = rbufslp(begp:endp) + if (use_crop) then call extract_accum_field ('TDM10', rbufslp, nstep) this%t_a10min_patch(begp:endp)= rbufslp(begp:endp) - call extract_accum_field ('TDM5', rbufslp, nstep) - this%t_a5min_patch(begp:endp) = rbufslp(begp:endp) end if ! Initialize variables that are to be time accumulated @@ -1317,6 +1329,7 @@ subroutine UpdateAccVars (this, bounds) use shr_const_mod , only : SHR_CONST_CDAY, SHR_CONST_TKFRZ use clm_time_manager , only : get_step_size, get_nstep, is_end_curr_day, get_curr_date use accumulMod , only : update_accum_field, extract_accum_field, accumResetVal + use CNSharedParamsMod, only : upper_soil_layer ! ! !ARGUMENTS: class(temperature_type) :: this @@ -1447,6 +1460,25 @@ subroutine UpdateAccVars (this, bounds) call update_accum_field ('T10', this%t_ref2m_patch, nstep) call extract_accum_field ('T10', this%t_a10_patch, nstep) + + ! Accumulate and extract SOIL10, for a sepcific soil layer + !(acumulates SOIL10 as 10-day running mean) + + do p = begp,endp + c = patch%column(p) + rbufslp(p) = this%t_soisno_col(c,upper_soil_layer) + end do + call update_accum_field ('SOIL10', rbufslp, nstep) + call extract_accum_field ('SOIL10', this%soila10_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) if ( use_crop )then ! Accumulate and extract TDM10 @@ -1458,14 +1490,7 @@ subroutine UpdateAccVars (this, bounds) 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 diff --git a/src/biogeophys/TotalWaterAndHeatMod.F90 b/src/biogeophys/TotalWaterAndHeatMod.F90 index ffce06b552..bfeea81949 100644 --- a/src/biogeophys/TotalWaterAndHeatMod.F90 +++ b/src/biogeophys/TotalWaterAndHeatMod.F90 @@ -24,7 +24,7 @@ module TotalWaterAndHeatMod use LakeStateType , only : lakestate_type use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall use column_varcon , only : icol_road_perv, icol_road_imperv - use landunit_varcon , only : istdlak, istsoil,istcrop,istwet,istice_mec + use landunit_varcon , only : istdlak, istsoil,istcrop,istwet,istice ! ! !PUBLIC TYPES: implicit none @@ -864,7 +864,7 @@ subroutine AccumulateSoilHeatNonLake(bounds, num_c, filter_c, & if (col%itype(c) == icol_road_imperv .and. j <= nlev_improad(l)) then soil_heat_dry_mass(c) = soil_heat_dry_mass(c) + & TempToHeat(temp = t_soisno(c,j), cv = (cv_improad(l,j) * dz(c,j))) - else if (lun%itype(l) /= istwet .and. lun%itype(l) /= istice_mec) then + else if (lun%itype(l) /= istwet .and. lun%itype(l) /= istice) then ! Note that this also includes impervious roads below nlev_improad (where ! we have soil) soil_heat_dry_mass(c) = soil_heat_dry_mass(c) + & diff --git a/src/biogeophys/WaterBalanceType.F90 b/src/biogeophys/WaterBalanceType.F90 index d8e6f3f8ba..0bf0573913 100644 --- a/src/biogeophys/WaterBalanceType.F90 +++ b/src/biogeophys/WaterBalanceType.F90 @@ -33,13 +33,16 @@ module WaterBalanceType real(r8), pointer :: snow_sources_col (:) ! col snow sources (mm H2O/s) real(r8), pointer :: snow_sinks_col (:) ! col snow sinks (mm H2O/s) + real(r8), pointer :: wa_reset_nonconservation_gain_col(:) ! col mass gained from resetting water in the unconfined aquifer, wa_col (negative indicates mass lost) (mm) ! Balance Checks - real(r8), pointer :: begwb_col (:) ! water mass begining of the time step - real(r8), pointer :: endwb_col (:) ! water mass end of the time step + real(r8), pointer :: begwb_grc (:) ! grid cell-level water mass begining of the time step + real(r8), pointer :: endwb_grc (:) ! grid cell-level water mass end of the time step + real(r8), pointer :: begwb_col (:) ! column-level water mass begining of the time step + real(r8), pointer :: endwb_col (:) ! column-level 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 :: errh2o_col (:) ! column-level water conservation error (mm H2O) real(r8), pointer :: errh2osno_col (:) ! snow water conservation error(mm H2O) contains @@ -47,6 +50,7 @@ module WaterBalanceType procedure :: Init procedure, private :: InitAllocate procedure, private :: InitHistory + procedure, private :: InitCold end type waterbalance_type @@ -68,8 +72,8 @@ subroutine Init(this, bounds, info, tracer_vars) this%info => info call this%InitAllocate(bounds, tracer_vars) - call this%InitHistory(bounds) + call this%InitCold(bounds) end subroutine Init @@ -111,7 +115,16 @@ subroutine InitAllocate(this, bounds, tracer_vars) call AllocateVar1d(var = this%snow_sinks_col, name = 'snow_sinks_col', & container = tracer_vars, & bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN) + call AllocateVar1d(var = this%wa_reset_nonconservation_gain_col, name = 'wa_reset_nonconservation_gain_col', & + container = tracer_vars, & + bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN) + call AllocateVar1d(var = this%begwb_grc, name = 'begwb_grc', & + container = tracer_vars, & + bounds = bounds, subgrid_level = BOUNDS_SUBGRID_GRIDCELL) + call AllocateVar1d(var = this%endwb_grc, name = 'endwb_grc', & + container = tracer_vars, & + bounds = bounds, subgrid_level = BOUNDS_SUBGRID_GRIDCELL) call AllocateVar1d(var = this%begwb_col, name = 'begwb_col', & container = tracer_vars, & bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN) @@ -225,4 +238,20 @@ subroutine InitHistory(this, bounds) ptr_col=this%errh2osno_col, c2l_scale_type='urbanf') end subroutine InitHistory + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !USES: + ! + ! !ARGUMENTS: + class(waterbalance_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + !----------------------------------------------------------------------- + + this%wa_reset_nonconservation_gain_col(bounds%begc:bounds%endc) = 0.0_r8 + + end subroutine InitCold + end module WaterBalanceType diff --git a/src/biogeophys/WaterDiagnosticBulkType.F90 b/src/biogeophys/WaterDiagnosticBulkType.F90 index 21cc9d283b..e0203deb74 100644 --- a/src/biogeophys/WaterDiagnosticBulkType.F90 +++ b/src/biogeophys/WaterDiagnosticBulkType.F90 @@ -38,6 +38,7 @@ module WaterDiagnosticBulkType real(r8), pointer :: h2osno_total_col (:) ! col total snow water (mm H2O) real(r8), pointer :: snow_depth_col (:) ! col snow height of snow covered area (m) + real(r8), pointer :: snow_5day_col (:) ! col snow height 5 day avg (m) real(r8), pointer :: snowdp_col (:) ! col area-averaged snow height (m) 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] @@ -78,11 +79,17 @@ module WaterDiagnosticBulkType contains - procedure, public :: InitBulk - procedure, public :: RestartBulk - procedure, public :: Summary - procedure, public :: ResetBulkFilter - procedure, public :: ResetBulk + ! Public interfaces + procedure, public :: InitBulk ! Initiatlization of bulk water diagnostics + procedure, public :: RestartBulk ! Restart bulk water diagnostics + procedure, public :: Summary ! Compute end of time-step summaries of terms + procedure, public :: ResetBulkFilter ! Reset the filter for bulk water + procedure, public :: ResetBulk ! Reset bulk water characteristics + procedure, public :: InitAccBuffer ! Initialize accumulation buffers + procedure, public :: InitAccVars ! Initialize accumulation variables + procedure, public :: UpdateAccVars ! Update accumulation variables + + ! Private subroutines procedure, private :: InitBulkAllocate procedure, private :: InitBulkHistory procedure, private :: InitBulkCold @@ -176,6 +183,7 @@ subroutine InitBulkAllocate(this, bounds) allocate(this%h2osno_total_col (begc:endc)) ; this%h2osno_total_col (:) = nan allocate(this%snow_depth_col (begc:endc)) ; this%snow_depth_col (:) = nan + allocate(this%snow_5day_col (begc:endc)) ; this%snow_5day_col (:) = nan allocate(this%snowdp_col (begc:endc)) ; this%snowdp_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 @@ -400,6 +408,13 @@ subroutine InitBulkHistory(this, bounds) avgflag='A', & long_name=this%info%lname('snow height of snow covered area'), & ptr_col=this%snow_depth_col, c2l_scale_type='urbanf') + this%snow_5day_col(begc:endc) = spval + call hist_addfld1d ( & + fname=this%info%fname('SNOW_5D'), & + units='m', & + avgflag='A', & + long_name=this%info%lname('5day snow avg'), & + ptr_col=this%snow_5day_col, c2l_scale_type='urbanf', default='inactive') call hist_addfld1d ( & fname=this%info%fname('SNOW_DEPTH_ICE'), & @@ -507,8 +522,102 @@ subroutine InitBulkHistory(this, bounds) ptr_patch=this%qflx_prec_intr_patch, set_lake=0._r8) end subroutine InitBulkHistory + + !----------------------------------------------------------------------- + + 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(waterdiagnosticbulk_type) :: this + type(bounds_type), intent(in) :: bounds + !--------------------------------------------------------------------- + + this%snow_5day_col(bounds%begc:bounds%endc) = spval + call init_accum_field (name='SNOW_5D', units='m', & + desc='5-day running mean of snowdepth', accum_type='runmean', accum_period=-5, & + subgrid_type='column', 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(waterdiagnosticbulk_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begc, endc + integer :: nstep + integer :: ier + real(r8), pointer :: rbufslp(:) ! temporary + !--------------------------------------------------------------------- + begc = bounds%begc; endc = bounds%endc + + ! Allocate needed dynamic memory for single level patch field + allocate(rbufslp(begc:endc), stat=ier) + + ! Determine time step + nstep = get_nstep() + call extract_accum_field ('SNOW_5D', rbufslp, nstep) + this%snow_5day_col(begc:endc) = rbufslp(begc:endc) + + deallocate(rbufslp) + + end subroutine InitAccVars + + !----------------------------------------------------------------------- + + subroutine UpdateAccVars (this, bounds) + ! + ! Update the accumulation variuables + ! + ! USES + use clm_time_manager, only : get_nstep + use accumulMod , only : update_accum_field, extract_accum_field + ! + ! !ARGUMENTS: + class(waterdiagnosticbulk_type) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: c ! indices + integer :: dtime ! timestep size [seconds] + integer :: nstep ! timestep number + integer :: ier ! error status + !--------------------------------------------------------------------- + + nstep = get_nstep() + + ! Allocate needed dynamic memory for single level patch field + + ! Accumulate and extract 5 day average of snow depth + call update_accum_field ('SNOW_5D', this%snow_depth_col, nstep) + call extract_accum_field ('SNOW_5D', this%snow_5day_col, nstep) + + end subroutine UpdateAccVars !----------------------------------------------------------------------- + subroutine InitBulkCold(this, bounds, & snow_depth_input_col, h2osno_input_col) ! @@ -829,31 +938,48 @@ end subroutine RestartBackcompatIssue783 subroutine Summary(this, bounds, & num_soilp, filter_soilp, & num_allc, filter_allc, & + num_nolakec, filter_nolakec, & waterstate_inst, waterflux_inst) ! ! !DESCRIPTION: ! Compute end-of-timestep summaries of water diagnostic terms ! + ! !USES: + use clm_varpar , only : nlevsoi ! !ARGUMENTS: class(waterdiagnosticbulk_type) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_soilp ! number of patches in soilp filter - integer , intent(in) :: filter_soilp(:) ! filter for soil patches - integer , intent(in) :: num_allc ! number of columns in allc filter - integer , intent(in) :: filter_allc(:) ! filter for all columns + integer , intent(in) :: num_soilp ! number of patches in soilp filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_allc ! number of columns in allc filter + integer , intent(in) :: filter_allc(:) ! filter for all columns + integer , intent(in) :: num_nolakec ! number of columns in no-lake columnc filter + integer , intent(in) :: filter_nolakec(:) ! filter for no-lake columns class(waterstate_type) , intent(in) :: waterstate_inst class(waterflux_type) , intent(in) :: waterflux_inst ! ! !LOCAL VARIABLES: - integer :: fp, p - integer :: fc, c + integer :: fp, p, j, l, fc, c ! Indices + real(r8):: fracl ! fraction of soil layer contributing to 10cm total soil water character(len=*), parameter :: subname = 'Summary' !----------------------------------------------------------------------- + associate( & + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness depth (m) + zi => col%zi , & ! Input: [real(r8) (:,:) ] interface depth (m) + + 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_ice_tot => this%h2osoi_ice_tot_col , & ! Output: [real(r8) (:) ] vertically summed ice lens (kg/m2) + h2osoi_liq_tot => this%h2osoi_liq_tot_col , & ! Output: [real(r8) (:) ] vertically summed liquid water (kg/m2) + h2osoi_liqice_10cm => this%h2osoi_liqice_10cm_col & ! Output: [real(r8) (:) ] liquid water + ice lens in top 10cm of soil (kg/m2) + ) call this%waterdiagnostic_type%Summary(bounds, & num_soilp, filter_soilp, & num_allc, filter_allc, & + num_nolakec, filter_nolakec, & waterstate_inst, waterflux_inst) call waterstate_inst%CalculateTotalH2osno(bounds, num_allc, filter_allc, & @@ -873,6 +999,40 @@ subroutine Summary(this, bounds, & waterflux_inst%qflx_liq_grnd_col(c) + & waterflux_inst%qflx_snow_grnd_col(c) end do + do fc = 1, num_nolakec + c = filter_nolakec(fc) + l = col%landunit(c) + if (.not. lun%urbpoi(l)) then + h2osoi_liqice_10cm(c) = 0.0_r8 + h2osoi_liq_tot(c) = 0._r8 + h2osoi_ice_tot(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 + if (zi(c,j) <= 0.1_r8) then + fracl = 1._r8 + 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) + h2osoi_liqice_10cm(c) = h2osoi_liqice_10cm(c) + & + (h2osoi_liq(c,j)+h2osoi_ice(c,j))* & + fracl + end if + end if + h2osoi_liq_tot(c) = h2osoi_liq_tot(c) + h2osoi_liq(c,j) + h2osoi_ice_tot(c) = h2osoi_ice_tot(c) + h2osoi_ice(c,j) + end if + end do + end do + + end associate end subroutine Summary diff --git a/src/biogeophys/WaterDiagnosticType.F90 b/src/biogeophys/WaterDiagnosticType.F90 index 448d422877..d3ef72849f 100644 --- a/src/biogeophys/WaterDiagnosticType.F90 +++ b/src/biogeophys/WaterDiagnosticType.F90 @@ -294,8 +294,9 @@ subroutine Restart(this, bounds, ncid, flag) ! Read/Write module information to/from restart file. ! ! !USES: - use clm_varcon , only : nameg + use clm_varcon , only : nameg, namec use ncdio_pio , only : file_desc_t, ncd_double + use clm_varctl , only : use_fates_planthydro use restUtilMod ! ! !ARGUMENTS: @@ -329,12 +330,22 @@ subroutine Restart(this, bounds, ncid, flag) units='kg/kg', & interpinic_flag='interp', readvar=readvar, data=this%qaf_lun) + if(use_fates_planthydro) then + call restartvar(ncid=ncid, flag=flag, & + varname=this%info%fname('TOTAL_PLANT_STORED_H2O'), & + xtype=ncd_double, dim1name=namec, & + long_name=this%info%lname('total plant stored water (for fates hydro)'), & + units='kg/m2', & + interpinic_flag='interp', readvar=readvar, data=this%total_plant_stored_h2o_col) + end if + end subroutine Restart !----------------------------------------------------------------------- subroutine Summary(this, bounds, & num_soilp, filter_soilp, & num_allc, filter_allc, & + num_nolakec, filter_nolakec, & waterstate_inst, waterflux_inst) ! ! !DESCRIPTION: @@ -347,6 +358,8 @@ subroutine Summary(this, bounds, & integer , intent(in) :: filter_soilp(:) ! filter for soil patches integer , intent(in) :: num_allc ! number of columns in allc filter integer , intent(in) :: filter_allc(:) ! filter for all columns + integer , intent(in) :: num_nolakec ! number of columns in no-lake filter + integer , intent(in) :: filter_nolakec(:) ! filter for no-lake columns class(waterstate_type) , intent(in) :: waterstate_inst class(waterflux_type) , intent(in) :: waterflux_inst ! diff --git a/src/biogeophys/WaterStateType.F90 b/src/biogeophys/WaterStateType.F90 index 243e93ca48..754e96dd91 100644 --- a/src/biogeophys/WaterStateType.F90 +++ b/src/biogeophys/WaterStateType.F90 @@ -87,7 +87,7 @@ subroutine Init(this, bounds, info, tracer_vars, & call this%InitAllocate(bounds, tracer_vars) - call this%InitHistory(bounds) + call this%InitHistory(bounds, use_aquifer_layer) call this%InitCold(bounds = bounds, & h2osno_input_col = h2osno_input_col, & @@ -154,7 +154,7 @@ subroutine InitAllocate(this, bounds, tracer_vars) end subroutine InitAllocate !------------------------------------------------------------------------ - subroutine InitHistory(this, bounds) + subroutine InitHistory(this, bounds, use_aquifer_layer) ! ! !DESCRIPTION: ! Initialize module data structure @@ -166,6 +166,7 @@ subroutine InitHistory(this, bounds) ! !ARGUMENTS: class(waterstate_type), intent(in) :: this type(bounds_type), intent(in) :: bounds + logical , intent(in) :: use_aquifer_layer ! whether an aquifer layer is used in this run ! ! !LOCAL VARIABLES: integer :: begp, endp @@ -259,13 +260,13 @@ subroutine InitHistory(this, bounds) long_name=this%info%lname('surface water depth'), & ptr_col=this%h2osfc_col) - this%wa_col(begc:endc) = spval - call hist_addfld1d (fname=this%info%fname('WA'), units='mm', & - avgflag='A', & - long_name=this%info%lname('water in the unconfined aquifer (natural vegetated and crop landunits only)'), & - ptr_col=this%wa_col, l2g_scale_type='veg') - - + if (use_aquifer_layer) then + this%wa_col(begc:endc) = spval + call hist_addfld1d (fname=this%info%fname('WA'), units='mm', & + avgflag='A', & + long_name=this%info%lname('water in the unconfined aquifer (natural vegetated and crop landunits only)'), & + ptr_col=this%wa_col, l2g_scale_type='veg') + end if ! (rgk 02-02-2017) There is intentionally no entry here for stored plant water ! I think that since the value is zero in all cases except @@ -287,7 +288,7 @@ subroutine InitCold(this, bounds, & ! ! !USES: use shr_const_mod , only : SHR_CONST_TKFRZ - use landunit_varcon , only : istwet, istsoil, istcrop, istice_mec + use landunit_varcon , only : istwet, istsoil, istcrop, istice use column_varcon , only : icol_road_perv, icol_road_imperv use clm_varcon , only : denice, denh2o, bdsno use clm_varcon , only : tfrz, aquifer_water_baseline @@ -384,7 +385,7 @@ subroutine InitCold(this, bounds, & this%h2osoi_vol_col(c,j) = 1.0_r8 * ratio endif end do - else if (lun%itype(l) == istice_mec) then + else if (lun%itype(l) == istice) then nlevs = nlevgrnd do j = 1, nlevs this%h2osoi_vol_col(c,j) = 1.0_r8 * ratio diff --git a/src/biogeophys/WaterType.F90 b/src/biogeophys/WaterType.F90 index 4744b63085..3bed3ff19f 100644 --- a/src/biogeophys/WaterType.F90 +++ b/src/biogeophys/WaterType.F90 @@ -665,6 +665,7 @@ subroutine InitAccBuffer(this, bounds) call this%waterfluxbulk_inst%InitAccBuffer(bounds) call this%wateratm2lndbulk_inst%InitAccBuffer(bounds) + call this%waterdiagnosticbulk_inst%InitAccBuffer(bounds) end subroutine InitAccBuffer @@ -685,6 +686,7 @@ subroutine InitAccVars(this, bounds) call this%waterfluxbulk_inst%initAccVars(bounds) call this%wateratm2lndbulk_inst%initAccVars(bounds) + call this%waterdiagnosticbulk_inst%initAccVars(bounds) end subroutine InitAccVars @@ -707,6 +709,7 @@ subroutine UpdateAccVars(this, bounds) call this%waterfluxbulk_inst%UpdateAccVars(bounds) call this%wateratm2lndbulk_inst%UpdateAccVars(bounds) + call this%waterdiagnosticbulk_inst%UpdateAccVars(bounds) end subroutine UpdateAccVars @@ -1009,8 +1012,9 @@ end subroutine ResetCheckedTracers !----------------------------------------------------------------------- subroutine Summary(this, bounds, & - num_soilp, filter_soilp, & - num_allc, filter_allc) + num_soilp, filter_soilp, & + num_allc, filter_allc, & + num_nolakec, filter_nolakec) ! ! !DESCRIPTION: ! Compute end-of-timestep summaries of water diagnostic terms @@ -1022,6 +1026,8 @@ subroutine Summary(this, bounds, & integer , intent(in) :: filter_soilp(:) ! filter for soil patches integer , intent(in) :: num_allc ! number of columns in allc filter integer , intent(in) :: filter_allc(:) ! filter for all columns + integer , intent(in) :: num_nolakec ! number of no-lake filter + integer , intent(in) :: filter_nolakec(:) ! filter for no-lake columns ! ! !LOCAL VARIABLES: integer :: i @@ -1037,6 +1043,8 @@ subroutine Summary(this, bounds, & filter_soilp = filter_soilp, & num_allc = num_allc, & filter_allc = filter_allc, & + num_nolakec = num_nolakec, & + filter_nolakec = filter_nolakec, & waterstate_inst = bulk_or_tracer%waterstate_inst, & waterflux_inst = bulk_or_tracer%waterflux_inst) end associate diff --git a/src/biogeophys/Waterlnd2atmType.F90 b/src/biogeophys/Waterlnd2atmType.F90 index ed6e9ca0dd..fb59d1c83c 100644 --- a/src/biogeophys/Waterlnd2atmType.F90 +++ b/src/biogeophys/Waterlnd2atmType.F90 @@ -32,7 +32,8 @@ module Waterlnd2atmType real(r8), pointer :: qflx_rofliq_qsub_grc (:) ! rof liq -- subsurface runoff component real(r8), pointer :: qflx_rofliq_qgwl_grc (:) ! rof liq -- glacier, wetland and lakes water balance residual component real(r8), pointer :: qflx_rofliq_drain_perched_grc (:) ! rof liq -- perched water table runoff component - real(r8), pointer :: qflx_rofice_grc (:) ! rof ice forcing + real(r8), pointer :: qflx_ice_runoff_col(:) ! rof ice forcing, col level + real(r8), pointer :: qflx_rofice_grc (:) ! rof ice forcing, grc level real(r8), pointer :: qflx_liq_from_ice_col(:) ! liquid runoff from converted ice runoff real(r8), pointer :: qirrig_grc (:) ! irrigation flux @@ -119,6 +120,10 @@ subroutine InitAllocate(this, bounds, tracer_vars) container = tracer_vars, & bounds = bounds, subgrid_level = BOUNDS_SUBGRID_GRIDCELL, & ival=ival) + call AllocateVar1d(var = this%qflx_ice_runoff_col, name = 'qflx_ice_runoff_col', & + container = tracer_vars, & + bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN, & + ival=ival) call AllocateVar1d(var = this%qflx_rofice_grc, name = 'qflx_rofice_grc', & container = tracer_vars, & bounds = bounds, subgrid_level = BOUNDS_SUBGRID_GRIDCELL, & diff --git a/src/biogeophys/test/SnowHydrology_test/test_SnowHydrology_SnowCappingExcess.pf b/src/biogeophys/test/SnowHydrology_test/test_SnowHydrology_SnowCappingExcess.pf index 7c67a69c9a..5f42d37226 100644 --- a/src/biogeophys/test/SnowHydrology_test/test_SnowHydrology_SnowCappingExcess.pf +++ b/src/biogeophys/test/SnowHydrology_test/test_SnowHydrology_SnowCappingExcess.pf @@ -13,7 +13,7 @@ module test_SnowHydrology_SnowCappingExcess use unittestArrayMod, only : col_array use clm_varcon, only : h2osno_max use clm_varpar, only : nlevsno - use landunit_varcon, only : istsoil, istice_mec + use landunit_varcon, only : istsoil, istice implicit none @@ -110,7 +110,7 @@ contains call SnowHydrologySetControlForTesting(set_reset_snow = .true., & set_reset_snow_glc = .false., set_reset_snow_glc_ela = 1000._r8) - call setup_landunit_ncols(ltype=istice_mec, ctypes=[1,1,1], cweights=[0.5_r8, 0.25_r8, 0.25_r8]) + call setup_landunit_ncols(ltype=istice, ctypes=[1,1,1], cweights=[0.5_r8, 0.25_r8, 0.25_r8]) call filter_from_range(bounds%begc, bounds%endc, num_snowc, filter_snowc) ! Column 2 exceeds the max, other columns don't h2osno = [reset_snow_h2osno - 1._r8, reset_snow_h2osno + my_excess, reset_snow_h2osno - 1._r8] @@ -136,7 +136,7 @@ contains call SnowHydrologySetControlForTesting(set_reset_snow_glc = .true., & set_reset_snow_glc_ela = ela) - call setup_landunit_ncols(ltype=istice_mec, ctypes=[1,1,1], cweights=[0.5_r8, 0.25_r8, 0.25_r8]) + call setup_landunit_ncols(ltype=istice, ctypes=[1,1,1], cweights=[0.5_r8, 0.25_r8, 0.25_r8]) call filter_from_range(bounds%begc, bounds%endc, num_snowc, filter_snowc) ! Column 2 exceeds the max, other columns don't h2osno = [reset_snow_h2osno - 1._r8, reset_snow_h2osno + my_excess, reset_snow_h2osno - 1._r8] @@ -163,7 +163,7 @@ contains call SnowHydrologySetControlForTesting(set_reset_snow_glc = .true., & set_reset_snow_glc_ela = ela) - call setup_landunit_ncols(ltype=istice_mec, ctypes=[1,1,1], cweights=[0.5_r8, 0.25_r8, 0.25_r8]) + call setup_landunit_ncols(ltype=istice, ctypes=[1,1,1], cweights=[0.5_r8, 0.25_r8, 0.25_r8]) call filter_from_range(bounds%begc, bounds%endc, num_snowc, filter_snowc) ! Column 2 exceeds the max, other columns don't h2osno = [reset_snow_h2osno - 1._r8, reset_snow_h2osno + my_excess, reset_snow_h2osno - 1._r8] diff --git a/src/cpl/lilac/lnd_comp_esmf.F90 b/src/cpl/lilac/lnd_comp_esmf.F90 index ba5f73c2b7..7d227a4134 100644 --- a/src/cpl/lilac/lnd_comp_esmf.F90 +++ b/src/cpl/lilac/lnd_comp_esmf.F90 @@ -32,13 +32,14 @@ module lnd_comp_esmf use clm_varctl , only : nsrStartup, nsrContinue use clm_varctl , only : inst_index, inst_suffix, inst_name use clm_time_manager , only : set_timemgr_init, advance_timestep - use clm_time_manager , only : set_nextsw_cday, update_rad_dtime + use clm_time_manager , only : update_rad_dtime use clm_time_manager , only : get_nstep, get_step_size use clm_time_manager , only : get_curr_date, get_curr_calday use clm_initializeMod , only : initialize1, initialize2 use clm_driver , only : clm_drv use lnd_import_export , only : import_fields, export_fields use lnd_shr_methods , only : chkerr, state_diagnose + use lnd_set_decomp_and_domain, only :lnd_set_decomp_and_domain_from_readmesh implicit none private ! By default make data private except @@ -109,7 +110,6 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) logical :: exists ! true if file exists character(len=CL) :: caseid ! case identifier name character(len=CL) :: starttype ! start-type (startup, continue, branch, hybrid) - real(r8) :: nextsw_cday ! calday next radiation computation integer :: nsrest ! clm restart type integer :: lbnum ! input to memory diagnostic integer :: shrlogunit ! old values for log unit and log level @@ -129,12 +129,10 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! mesh generation type(ESMF_Mesh) :: lnd_mesh character(ESMF_MAXSTR) :: lnd_mesh_filename ! full filepath of land mesh file - integer :: nlnd, nocn ! local size ofarrays integer, pointer :: gindex(:) ! global index space for land and ocean points - integer, pointer :: gindex_lnd(:) ! global index space for just land points - integer, pointer :: gindex_ocn(:) ! global index space for just ocean points type(ESMF_DistGrid) :: distgrid integer :: fileunit + integer :: ni, nj ! clock info character(len=CL) :: calendar ! calendar type name @@ -320,87 +318,41 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) call set_timemgr_init( & calendar_in=calendar, start_ymd_in=start_ymd, start_tod_in=start_tod, & ref_ymd_in=ref_ymd, ref_tod_in=ref_tod, dtime_in=dtime_lilac) + call ESMF_LogWrite(subname//"ctsm time manager initialized....", ESMF_LOGMSG_INFO) !---------------------- ! Read namelist, grid and surface data !---------------------- - ! set default values for run control variables call clm_varctl_set(caseid_in=caseid, nsrest_in=nsrest) - call ESMF_LogWrite(subname//"default values for run control variables are set...", ESMF_LOGMSG_INFO) - - !---------------------- ! Initialize glc_elevclass module - !---------------------- - call glc_elevclass_init(glc_nec) + call ESMF_LogWrite(subname//"default values for run control variables are set...", ESMF_LOGMSG_INFO) !---------------------- ! Call initialize1 !---------------------- - - ! Note that the memory for gindex_ocn will be allocated in the following call - - call initialize1(dtime=dtime_lilac, gindex_ocn=gindex_ocn) - - call ESMF_LogWrite(subname//"ctsm time manager initialized....", ESMF_LOGMSG_INFO) + call initialize1(dtime=dtime_lilac) call ESMF_LogWrite(subname//"ctsm initialize1 done...", ESMF_LOGMSG_INFO) - !-------------------------------- - ! generate the land mesh on ctsm distribution - !-------------------------------- - - ! obtain global index array for just land points which includes mask=0 or ocean points - call get_proc_bounds( bounds ) - - nlnd = bounds%endg - bounds%begg + 1 - allocate(gindex_lnd(nlnd)) - do g = bounds%begg,bounds%endg - n = 1 + (g - bounds%begg) - gindex_lnd(n) = ldecomp%gdc2glo(g) - end do - - call ESMF_LogWrite(subname//"obtained global index", ESMF_LOGMSG_INFO) - - ! create a global index that includes both land and ocean points - nocn = size(gindex_ocn) - allocate(gindex(nlnd + nocn)) - do n = 1,nlnd+nocn - if (n <= nlnd) then - gindex(n) = gindex_lnd(n) - else - gindex(n) = gindex_ocn(n-nlnd) - end if - end do - - ! create distGrid from global index array - DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - deallocate(gindex) - call ESMF_LogWrite(subname//"DistGrid created......", ESMF_LOGMSG_INFO) - - ! create esmf mesh using distgrid and lnd_mesh_filename - lnd_mesh = ESMF_MeshCreate(filename=trim(lnd_mesh_filename), fileformat=ESMF_FILEFORMAT_ESMFMESH, & - elementDistgrid=Distgrid, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) then - call shr_sys_abort("Error in creating mesh "// trim(lnd_mesh_filename)) - end if - if (masterproc) then - write(iulog,*)'mesh file for domain is ',trim(lnd_mesh_filename) - end if - call ESMF_LogWrite(subname//" Create Mesh using file ...."//trim(lnd_mesh_filename), ESMF_LOGMSG_INFO) + !---------------------- + ! Initialize decomposition (ldecomp) and domain (ldomain) types and generate land mesh + !---------------------- + ! TODO: generalize this so that a mask mesh is read in like for nuopc/cmeps + ! For now set the meshfile_mask equal to the model_meshfile + call lnd_set_decomp_and_domain_from_readmesh(driver='lilac', vm=vm, & + meshfile_lnd=lnd_mesh_filename, meshfile_mask=lnd_mesh_filename, & + mesh_ctsm=lnd_mesh, ni=ni, nj=nj, rc=rc) !-------------------------------- ! Finish initializing ctsm !-------------------------------- - - call initialize2() + call initialize2(ni,nj) call ESMF_LogWrite(subname//"ctsm initialize2 done...", ESMF_LOGMSG_INFO) !-------------------------------- ! Create import state (only assume input from atm - not rof and glc) !-------------------------------- - ! create an empty field bundle for import of atm fields c2l_fb_atm = ESMF_FieldBundleCreate (name='c2l_fb_atm', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -477,6 +429,8 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) ! Fill in ctsm export state !-------------------------------- + call get_proc_bounds( bounds ) + call export_fields(export_state, bounds, rc=rc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(rc=rc, endflag=ESMF_END_ABORT) @@ -492,31 +446,6 @@ subroutine lnd_init(comp, import_state, export_state, clock, rc) call ESMF_LogWrite(subname//"Created land export state", ESMF_LOGMSG_INFO) - !-------------------------------- - ! Get calendar day of next sw (shortwave) calculation (nextsw_cday) - !-------------------------------- - - if (nsrest == nsrStartup) then - call ESMF_ClockGet( clock, currTime=currTime, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - ! TODO: get this from the import state nextsw_cday attribute - ! - ! See also https://github.com/ESCOMP/CTSM/issues/860 - end if - - ! Set nextsw_cday - call set_nextsw_cday(nextsw_cday_in=nextsw_cday) - - write(cvalue,*) nextsw_cday - call ESMF_LogWrite(subname//"Calendar Day of nextsw calculation is "//trim(cvalue), ESMF_LOGMSG_INFO) - if (masterproc) then - write(iulog,*) 'TimeGet ... nextsw_cday is : ', nextsw_cday - end if - !-------------------------------- ! diagnostics !-------------------------------- @@ -860,15 +789,6 @@ subroutine lnd_run(gcomp, import_state, export_state, clock, rc) ! diagnostics !-------------------------------- - !if (dbug > 1) then - ! call State_diagnose(exportState,subname//':ES',rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! if (masterproc) then - ! call log_clock_advance(clock, 'CTSM', iulog, rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! end if - !end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) #if (defined _MEMTRACE) diff --git a/src/cpl/lilac/lnd_import_export.F90 b/src/cpl/lilac/lnd_import_export.F90 index 581bdbedc8..32d1bace46 100644 --- a/src/cpl/lilac/lnd_import_export.F90 +++ b/src/cpl/lilac/lnd_import_export.F90 @@ -4,7 +4,7 @@ module lnd_import_export use shr_kind_mod , only : r8 => shr_kind_r8, cx=>shr_kind_cx, cxx=>shr_kind_cxx, cs=>shr_kind_cs use shr_sys_mod , only : shr_sys_abort use shr_const_mod , only : fillvalue=>SHR_CONST_SPVAL - use clm_varctl , only : iulog, ndep_from_cpl + use clm_varctl , only : iulog, ndep_from_cpl, co2_ppmv use clm_time_manager , only : get_nstep use clm_instMod , only : atm2lnd_inst, lnd2atm_inst, water_inst use domainMod , only : ldomain @@ -34,7 +34,6 @@ module lnd_import_export integer :: drydep_nflds ! number of dry deposition velocity fields lnd-> atm integer :: emis_nflds ! number of fire emission fields from lnd-> atm - integer :: glc_nec = 10 ! number of glc elevation classes integer, parameter :: debug = 0 ! internal debug level character(*),parameter :: F01 = "('(lnd_import_export) ',a,i5,2x,i5,2x,d21.14)" @@ -70,12 +69,12 @@ subroutine import_fields( importState, bounds, first_call, rc) real(r8) :: qsat_kg_kg ! saturation specific humidity (kg/kg) real(r8) :: forc_noy(bounds%begg:bounds%endg) real(r8) :: forc_nhx(bounds%begg:bounds%endg) + real(r8) :: forc_pbot ! atmospheric pressure (Pa) character(len=*), parameter :: subname='(lnd_import_export:import_fields)' !--------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! Set bounds begg = bounds%begg; endg=bounds%endg @@ -249,6 +248,11 @@ subroutine import_fields( importState, bounds, first_call, rc) call check_for_errors(bounds, atm2lnd_inst, water_inst%wateratm2lndbulk_inst) + do g = begg, endg + forc_pbot = atm2lnd_inst%forc_pbot_not_downscaled_grc(g) + atm2lnd_inst%forc_pco2_grc(g) = co2_ppmv * 1.e-6_r8 * forc_pbot + end do + end subroutine import_fields !=============================================================================== @@ -277,7 +281,7 @@ subroutine check_atm_landfrac(importState, bounds, rc) !--------------------------------------------------------------------------- ! Implementation notes: The CTSM decomposition is set up so that ocean points appear - ! at the end of the vectors received from the coupler. Thus, in order to check if + ! at the end of the vectors received from the atm. Thus, in order to check if ! there are any points that the atmosphere considers land but CTSM considers ocean, ! it is sufficient to check the points following the typical ending bounds in the ! vectors received from the coupler. @@ -293,7 +297,6 @@ subroutine check_atm_landfrac(importState, bounds, rc) if (atm_landfrac(n) > 0._r8) then write(iulog,*) 'At point ', n, ' atm landfrac = ', atm_landfrac(n) write(iulog,*) 'but CTSM thinks this is ocean.' - write(iulog,*) "Make sure the mask on CTSM's fatmlndfrc file agrees with the atmosphere's land mask" call shr_sys_abort( subname//& ' ERROR: atm landfrac > 0 for a point that CTSM thinks is ocean') end if @@ -519,8 +522,6 @@ subroutine state_getimport(state, fb, fldname, bounds, output, ungridded_index, rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - if (masterproc .and. debug > 0) then write(iulog,F01)' Show me what is in the state? for '//trim(fldname) call ESMF_StatePrint(state, rc=rc) @@ -530,12 +531,16 @@ subroutine state_getimport(state, fb, fldname, bounds, output, ungridded_index, ! Get the pointer to data in the field if (present(ungridded_index)) then write(cvalue,*) ungridded_index - call ESMF_LogWrite(trim(subname)//": getting import for "//trim(fldname)//" index "//trim(cvalue), & - ESMF_LOGMSG_INFO) + if (debug > 0) then + call ESMF_LogWrite(trim(subname)//": getting import for "//trim(fldname)//" index "//trim(cvalue), & + ESMF_LOGMSG_INFO) + end if call state_getfldptr(state, trim(fb), trim(fldname), fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)//": getting import for "//trim(fldname),ESMF_LOGMSG_INFO) + if (debug > 0) then + call ESMF_LogWrite(trim(subname)//": getting import for "//trim(fldname),ESMF_LOGMSG_INFO) + end if call state_getfldptr(state, trim(fb), trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -605,12 +610,16 @@ subroutine state_setexport(state, fb, fldname, bounds, input, minus, ungridded_i ! get field pointer if (present(ungridded_index)) then - call ESMF_LogWrite(trim(subname)//": setting export for "//trim(fldname)//" index "//trim(cvalue), & - ESMF_LOGMSG_INFO) + if (debug > 0) then + call ESMF_LogWrite(trim(subname)//": setting export for "//trim(fldname)//" index "//trim(cvalue), & + ESMF_LOGMSG_INFO) + end if call state_getfldptr(state, trim(fb), trim(fldname), fldptr2d=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)//": setting export for "//trim(fldname), ESMF_LOGMSG_INFO) + if (debug > 0) then + call ESMF_LogWrite(trim(subname)//": setting export for "//trim(fldname), ESMF_LOGMSG_INFO) + end if call state_getfldptr(state, trim(fb), trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -670,8 +679,6 @@ subroutine state_getfldptr(State, fb, fldname, fldptr1d, fldptr2d, rc) ! local variables type(ESMF_FieldStatus_Flag) :: status type(ESMF_Field) :: lfield - type(ESMF_Mesh) :: lmesh - integer :: nnodes, nelements type(ESMF_FieldBundle) :: fieldBundle character(len=*), parameter :: subname='(lnd_import_export:state_getfldptr)' ! ---------------------------------------------- @@ -695,18 +702,6 @@ subroutine state_getfldptr(State, fb, fldname, fldptr1d, fldptr2d, rc) rc = ESMF_FAILURE return else - call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (nnodes == 0 .and. nelements == 0) then - call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - ! Get the data from the field if (present(fldptr1d)) then call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) diff --git a/src/cpl/mct/clm_cpl_indices.F90 b/src/cpl/mct/clm_cpl_indices.F90 index 525b709cc6..dfd3dcade8 100644 --- a/src/cpl/mct/clm_cpl_indices.F90 +++ b/src/cpl/mct/clm_cpl_indices.F90 @@ -19,7 +19,7 @@ module clm_cpl_indices ! !PUBLIC DATA MEMBERS: ! integer , public :: glc_nec ! number of elevation classes for glacier_mec landunits - ! (from coupler) - must equal maxpatch_glcmec from namelist + ! (from coupler) - must equal maxpatch_glc from namelist ! lnd -> drv (required) diff --git a/src/cpl/mct/lnd_comp_mct.F90 b/src/cpl/mct/lnd_comp_mct.F90 index 1ae6b9f6b9..f94a3544dc 100644 --- a/src/cpl/mct/lnd_comp_mct.F90 +++ b/src/cpl/mct/lnd_comp_mct.F90 @@ -9,6 +9,7 @@ module lnd_comp_mct ! !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 mct_mod , only : mct_avect, mct_gsmap, mct_gGrid use decompmod , only : bounds_type, ldecomp use lnd_import_export, only : lnd_import, lnd_export @@ -27,11 +28,13 @@ module lnd_comp_mct private :: lnd_setgsmap_mct ! set the land model mct gs map private :: lnd_domain_mct ! set the land model domain information private :: lnd_handle_resume ! handle pause/resume signals from the coupler - !--------------------------------------------------------------------------- -contains + character(len=*), parameter, private :: sourcefile = & + __FILE__ - !==================================================================================== +!==================================================================================== +contains +!==================================================================================== subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) ! @@ -42,10 +45,10 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) ! !USES: use shr_kind_mod , only : shr_kind_cl use abortutils , only : endrun - use clm_time_manager , only : get_nstep, set_timemgr_init, set_nextsw_cday + use clm_time_manager , only : get_nstep, set_timemgr_init use clm_initializeMod, only : initialize1, initialize2 use clm_instMod , only : water_inst, lnd2atm_inst, lnd2glc_inst - use clm_varctl , only : finidat,single_column, clm_varctl_set, iulog, noland + use clm_varctl , only : finidat, single_column, clm_varctl_set, iulog use clm_varctl , only : inst_index, inst_suffix, inst_name use clm_varorb , only : eccen, obliqr, lambm0, mvelpp use controlMod , only : control_setNL @@ -65,6 +68,7 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch use clm_cpl_indices , only : clm_cpl_indices_set use mct_mod , only : mct_aVect_init, mct_aVect_zero, mct_gsMap_lsize + use lnd_set_decomp_and_domain, only : lnd_set_decomp_and_domain_from_surfrd use ESMF ! ! !ARGUMENTS: @@ -86,7 +90,6 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) 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) @@ -103,21 +106,21 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) integer :: lbnum ! input to memory diagnostic integer :: shrlogunit,shrloglev ! old values for log unit and log level type(bounds_type) :: bounds ! bounds + logical :: noland + integer :: ni,nj + real(r8) , parameter :: rundef = -9999999._r8 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) @@ -148,18 +151,16 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) 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 - + ! initialize1 reads namelists + ! decomp and domain are set in lnd_set_decomp_and_domain_from_surfrd + ! initialize2 performs the rest of initialization call seq_timemgr_EClockGetData(EClock, & start_ymd=start_ymd, & start_tod=start_tod, ref_ymd=ref_ymd, & @@ -169,7 +170,6 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) if (masterproc) then write(iulog,*)'dtime = ',dtime_sync end if - call seq_infodata_GetData(infodata, case_name=caseid, & case_desc=ctitle, single_column=single_column, & scmlat=scmlat, scmlon=scmlon, & @@ -177,6 +177,12 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) start_type=starttype, model_version=version, & hostname=hostname, username=username ) + ! 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(sourcefile, __LINE__)) + end if + ! Note that we assume that CTSM's internal dtime matches the coupling time step. ! i.e., we currently do NOT allow sub-cycling within a coupling time step. call set_timemgr_init( calendar_in=calendar, start_ymd_in=start_ymd, start_tod_in=start_tod, & @@ -192,83 +198,71 @@ subroutine lnd_init_mct( EClock, cdata_l, x2l_l, l2x_l, NLFilename ) call endrun( sub//' ERROR: unknown starttype' ) end if + ! set default values for run control variables 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 - + ! Read namelists call initialize1(dtime=dtime_sync) - ! If no land then exit out of initialization + ! Initialize decomposition (ldecomp) and domain (ldomain) types + call lnd_set_decomp_and_domain_from_surfrd(noland, ni, nj) + ! 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() - - ! Create land export state - - call lnd_export(bounds, water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, l2x_l%rattr) + else - ! Fill in infodata settings + ! 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 - call seq_infodata_PutData(infodata, lnd_prognostic=.true.) - call seq_infodata_PutData(infodata, lnd_nx=ldomain%ni, lnd_ny=ldomain%nj) + ! 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) - ! Get infodata info + ! Finish initializing clm + call initialize2(ni,nj) - call seq_infodata_GetData(infodata, nextsw_cday=nextsw_cday ) - call set_nextsw_cday(nextsw_cday) - call lnd_handle_resume( cdata_l ) + ! Create land export state + call lnd_export(bounds, water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, l2x_l%rattr) - ! Reset shr logging to original values + ! 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) + call lnd_handle_resume( cdata_l ) - call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) + ! 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 + 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 if end subroutine lnd_init_mct !==================================================================================== - subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) ! ! !DESCRIPTION: @@ -279,7 +273,7 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) use clm_instMod , only : water_inst, 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 clm_time_manager, only : advance_timestep, update_rad_dtime use decompMod , only : get_proc_bounds use abortutils , only : endrun use clm_varctl , only : iulog @@ -363,7 +357,6 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) 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() ! Handle pause/resume signals from coupler @@ -500,7 +493,6 @@ subroutine lnd_run_mct(EClock, cdata_l, x2l_l, l2x_l) end subroutine lnd_run_mct !==================================================================================== - subroutine lnd_final_mct( EClock, cdata_l, x2l_l, l2x_l) ! ! !DESCRIPTION: @@ -522,7 +514,6 @@ subroutine lnd_final_mct( EClock, cdata_l, x2l_l, l2x_l) end subroutine lnd_final_mct !==================================================================================== - subroutine lnd_setgsmap_mct( bounds, mpicom_lnd, LNDID, gsMap_lnd ) ! ! !DESCRIPTION: @@ -550,11 +541,9 @@ subroutine lnd_setgsmap_mct( bounds, mpicom_lnd, LNDID, gsMap_lnd ) ! 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 @@ -568,7 +557,6 @@ subroutine lnd_setgsmap_mct( bounds, mpicom_lnd, LNDID, gsMap_lnd ) end subroutine lnd_SetgsMap_mct !==================================================================================== - subroutine lnd_domain_mct( bounds, lsize, gsMap_l, dom_l ) ! ! !DESCRIPTION: @@ -660,7 +648,6 @@ subroutine lnd_domain_mct( bounds, lsize, gsMap_l, dom_l ) end subroutine lnd_domain_mct !==================================================================================== - subroutine lnd_handle_resume( cdata_l ) ! ! !DESCRIPTION: diff --git a/src/cpl/mct/lnd_import_export.F90 b/src/cpl/mct/lnd_import_export.F90 index afdf575a30..9015b98988 100644 --- a/src/cpl/mct/lnd_import_export.F90 +++ b/src/cpl/mct/lnd_import_export.F90 @@ -128,20 +128,6 @@ subroutine lnd_import( bounds, x2l, glc_present, atm2lnd_inst, glc2lnd_inst, wat 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 @@ -173,6 +159,18 @@ subroutine lnd_import( bounds, x2l, glc_present, atm2lnd_inst, glc2lnd_inst, wat forc_pbot = atm2lnd_inst%forc_pbot_not_downscaled_grc(g) + ! 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 (co2_type_idx == 1) then co2_ppmv_val = co2_ppmv_prog else if (co2_type_idx == 2) then @@ -183,7 +181,7 @@ subroutine lnd_import( bounds, x2l, glc_present, atm2lnd_inst, glc2lnd_inst, wat if ( (co2_ppmv_val < 10.0_r8) .or. (co2_ppmv_val > 15000.0_r8) )then call endrun( sub//' ERROR: CO2 is outside of an expected range' ) end if - atm2lnd_inst%forc_pco2_grc(g) = co2_ppmv_val * 1.e-6_r8 * forc_pbot + 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 diff --git a/src/cpl/mct/lnd_set_decomp_and_domain.F90 b/src/cpl/mct/lnd_set_decomp_and_domain.F90 new file mode 100644 index 0000000000..0e1dbb9477 --- /dev/null +++ b/src/cpl/mct/lnd_set_decomp_and_domain.F90 @@ -0,0 +1,294 @@ +module lnd_set_decomp_and_domain + + use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl + use spmdMod , only : masterproc + use clm_varctl , only : iulog + use perf_mod , only : t_startf, t_stopf, t_barrierf + + implicit none + private ! except + + ! public member routines + public :: lnd_set_decomp_and_domain_from_surfrd + + ! private member routines + private :: surfrd_get_globmask ! Reads global land mask (needed for setting domain decomp) + private :: surfrd_get_grid ! Read grid/ladnfrac data into domain (after domain decomp) + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine lnd_set_decomp_and_domain_from_surfrd(noland, ni, nj) + + ! Initialize ldecomp and ldomain data types + + use clm_varpar , only: nlevsoi + use clm_varctl , only: fatmlndfrc, use_soil_moisture_streams + use decompInitMod , only: decompInit_lnd, decompInit_lnd3D + use decompMod , only: bounds_type, get_proc_bounds + use domainMod , only: ldomain, domain_init, domain_check + + ! input/output variables + logical, intent(out) :: noland + integer, intent(out) :: ni, nj ! global grid sizes + + ! local variables + integer ,pointer :: amask(:) ! global land mask + integer :: begg, endg ! processor bounds + type(bounds_type) :: bounds ! bounds + character(len=32) :: subname = 'lnd_set_decomp_and_domain_from_surfrd' + !----------------------------------------------------------------------- + + ! 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) + endif + + ! Get global mask, ni and nj + 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 + else + noland = .false. + end if + + ! Initialize ldecomp data type + ! Determine ctsm gridcell decomposition and processor bounds for gridcells + call decompInit_lnd(ni, nj, amask) + deallocate(amask) + if (use_soil_moisture_streams) call decompInit_lnd3D(ni, nj, nlevsoi) + + ! Initialize bounds for just gridcells + ! 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(bounds) + + ! Get grid cell bounds values + begg = bounds%begg + endg = bounds%endg + + ! Initialize ldomain data type + if (masterproc) then + write(iulog,*) 'Attempting to read ldomain from ',trim(fatmlndfrc) + endif + call surfrd_get_grid(begg, endg, ldomain, fatmlndfrc) + if (masterproc) then + call domain_check(ldomain) + endif + ldomain%mask = 1 !!! TODO - is this needed? + + end subroutine lnd_set_decomp_and_domain_from_surfrd + + !----------------------------------------------------------------------- + subroutine surfrd_get_globmask(filename, mask, ni, nj) + + ! Read the surface dataset grid related information + ! This is used to set the domain decomposition - so global data is read here + + use fileutils , only : getfil + use ncdio_pio , only : ncd_io, ncd_pio_openfile, ncd_pio_closefile, ncd_inqfdims, file_desc_t + use abortutils , only : endrun + use shr_log_mod, only : errMsg => shr_log_errMsg + + ! input/output variables + 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 + 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 + else + ! Check if file exists + if (masterproc) then + if (filename == ' ') then + write(iulog,*) trim(subname),' ERROR: filename must be specified ' + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + end if + + ! Open file + 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 + ! Grid is 2d + 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 + ! Grid is not 2d + 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(sourcefile, __LINE__)) + + ! Close file + call ncd_pio_closefile(ncid) + end if + + end subroutine surfrd_get_globmask + + !----------------------------------------------------------------------- + subroutine surfrd_get_grid(begg, endg, ldomain, filename, glcfilename) + + ! Read the surface dataset grid related information: + ! This is called after the domain decomposition has been created + ! - real latitude of grid cell (degrees) + ! - real longitude of grid cell (degrees) + + use clm_varcon , only : spval, re, grlnd + use domainMod , only : domain_type, domain_init, domain_clean, lon1d, lat1d + use fileutils , only : getfil + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + 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_size, ncd_inqdid, ncd_inqdlen + use pio + + ! input/output variables + 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 + 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 + 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(sourcefile, __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='xc', readvar=readvar) + if (readvar)then + istype_domain = .true. + else + istype_domain = .false. + end if + + ! 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(sourcefile, __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(sourcefile, __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(sourcefile, __LINE__)) + else + call endrun( msg=" ERROR: can no longer read non domain files" ) + end if + + if (isgrid2d) then + allocate(rdata2d(ni,nj), lon1d(ni), lat1d(nj)) + if (istype_domain) vname = 'xc' + call ncd_io(ncid=ncid, varname=trim(vname), data=rdata2d, flag='read', readvar=readvar) + lon1d(:) = rdata2d(:,1) + if (istype_domain) vname = 'yc' + 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) + endif + if ( any(ldomain%lonc < 0.0_r8) )then + call endrun( msg=' ERROR: lonc is negative (see https://github.com/ESCOMP/ctsm/issues/507)' & + //errMsg(sourcefile, __LINE__)) + endif + 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(sourcefile, __LINE__)) + end if + 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(sourcefile, __LINE__)) + end if + + call ncd_pio_closefile(ncid) + + end subroutine surfrd_get_grid + +end module lnd_set_decomp_and_domain diff --git a/src/cpl/nuopc/lnd_comp_nuopc.F90 b/src/cpl/nuopc/lnd_comp_nuopc.F90 index af4f1c64bf..19c7748297 100644 --- a/src/cpl/nuopc/lnd_comp_nuopc.F90 +++ b/src/cpl/nuopc/lnd_comp_nuopc.F90 @@ -20,43 +20,38 @@ module lnd_comp_nuopc use shr_orb_mod , only : shr_orb_decl, shr_orb_params, SHR_ORB_UNDEF_REAL, SHR_ORB_UNDEF_INT use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date use spmdMod , only : masterproc, mpicom, spmd_init - use decompMod , only : bounds_type, ldecomp, get_proc_bounds - use domainMod , only : ldomain - use controlMod , only : control_setNL + use controlMod , only : control_setNL, control_init, control_print, NLFilename use clm_varorb , only : eccen, obliqr, lambm0, mvelpp use clm_varctl , only : inst_index, inst_suffix, inst_name use clm_varctl , only : single_column, clm_varctl_set, iulog use clm_varctl , only : nsrStartup, nsrContinue, nsrBranch - use clm_varcon , only : re use clm_time_manager , only : set_timemgr_init, advance_timestep - use clm_time_manager , only : set_nextsw_cday, update_rad_dtime + use clm_time_manager , only : update_rad_dtime use clm_time_manager , only : get_nstep, get_step_size use clm_time_manager , only : get_curr_date, get_curr_calday use clm_initializeMod , only : initialize1, initialize2 - use clm_driver , only : clm_drv use nuopc_shr_methods , only : chkerr, state_setscalar, state_getscalar, state_diagnose, alarmInit use nuopc_shr_methods , only : set_component_logging, get_component_instance, log_clock_advance - use perf_mod , only : t_startf, t_stopf, t_barrierf - use netcdf , only : nf90_open, nf90_nowrite, nf90_noerr, nf90_close, nf90_strerror - use netcdf , only : nf90_inq_dimid, nf90_inq_varid, nf90_get_var - use netcdf , only : nf90_inquire_dimension, nf90_inquire_variable use lnd_import_export , only : advertise_fields, realize_fields, import_fields, export_fields use lnd_comp_shr , only : mesh, model_meshfile, model_clock + use perf_mod , only : t_startf, t_stopf, t_barrierf implicit none private ! except - ! Module routines - public :: SetServices - public :: SetVM - private :: InitializeP0 - private :: InitializeAdvertise - private :: InitializeRealize - private :: ModelSetRunClock - private :: ModelAdvance - private :: ModelFinalize - private :: clm_orbital_init - private :: clm_orbital_update + ! Module public routines + public :: SetServices ! Setup the pointers to the function calls for the different models phases (initialize, run, finalize) + public :: SetVM ! Set the virtual machine description of the paralell model (both MPI and OpenMP) + + ! Module private routines + private :: InitializeP0 ! Phase zero of initialization + private :: InitializeAdvertise ! Advertise the fields that can be passed + private :: InitializeRealize ! Realize the list of fields that will be exchanged + private :: ModelSetRunClock ! Set the run clock + private :: ModelAdvance ! Advance the model + private :: ModelFinalize ! Finalize the model + private :: clm_orbital_init ! Initialize the orbital information + private :: clm_orbital_update ! Update the orbital information !-------------------------------------------------------------------------- ! Private module data @@ -70,10 +65,9 @@ module lnd_comp_nuopc logical :: glc_present logical :: rof_prognostic + logical :: atm_prognostic integer, parameter :: dbug = 0 character(*),parameter :: modName = "(lnd_comp_nuopc)" - character(*),parameter :: u_FILE_u = & - __FILE__ character(len=CL) :: orb_mode ! attribute - orbital mode integer :: orb_iyear ! attribute - orbital year @@ -82,15 +76,27 @@ module lnd_comp_nuopc real(R8) :: orb_mvelp ! attribute - moving vernal equinox longitude real(R8) :: orb_eccen ! attribute and update- orbital eccentricity + logical :: scol_valid ! if single_column, does point have a mask of zero + + integer :: nthrds ! Number of threads per task in this component + character(len=*) , parameter :: orb_fixed_year = 'fixed_year' character(len=*) , parameter :: orb_variable_year = 'variable_year' character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' + character(len=*) , parameter :: startup_run = 'startup' + character(len=*) , parameter :: continue_run = 'continue' + character(len=*) , parameter :: branch_run = 'branch' + + character(len=*) , parameter :: u_FILE_u = & + __FILE__ + !=============================================================================== contains !=============================================================================== subroutine SetServices(gcomp, rc) + ! Setup the pointers to the function calls for the different models phases (initialize, run, finalize) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -137,9 +143,9 @@ subroutine SetServices(gcomp, rc) end subroutine SetServices !=============================================================================== - subroutine InitializeP0(gcomp, importState, exportState, clock, rc) + ! Phase zero initialization ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -150,16 +156,15 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) rc = ESMF_SUCCESS ! Switch to IPDv01 by filtering all other phaseMap entries - call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, acceptStringList=(/"IPDv01p"/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine InitializeP0 !=============================================================================== - subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + ! Advertise the fields that can be exchanged ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -167,17 +172,19 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables - type(ESMF_VM) :: vm - integer :: lmpicom - integer :: ierr - integer :: n - integer :: localpet - integer :: compid ! component id - integer :: shrlogunit ! original log unit - character(len=CL) :: cvalue - character(len=CL) :: logmsg - logical :: isPresent, isSet - logical :: cism_evolve + type(ESMF_VM) :: vm + integer :: lmpicom + integer :: ierr + integer :: n + integer :: localPet ! local PET (Persistent Execution Threads) (both MPI tasks and OpenMP threads) + integer :: compid ! component id + integer :: shrlogunit ! original log unit + character(len=CL) :: cvalue + character(len=CL) :: logmsg + logical :: cism_evolve + character(len=CL) :: atm_model + character(len=CL) :: rof_model + character(len=CL) :: glc_model character(len=*), parameter :: subname=trim(modName)//':(InitializeAdvertise) ' character(len=*), parameter :: format = "('("//trim(subname)//") :',A)" !------------------------------------------------------------------------------- @@ -191,7 +198,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, mpiCommunicator=lmpicom, localpet=localpet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -228,98 +234,74 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! advertise fields !---------------------------------------------------------------------------- - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - flds_scalar_name = trim(cvalue) - call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call shr_sys_abort(subname//'Need to set attribute ScalarFieldName') - endif - - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + flds_scalar_name = trim(cvalue) + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue, *) flds_scalar_num - write(logmsg,*) flds_scalar_num - call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call shr_sys_abort(subname//'Need to set attribute ScalarFieldCount') - endif - - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + read(cvalue, *) flds_scalar_num + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) flds_scalar_index_nx - write(logmsg,*) flds_scalar_index_nx - call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNX') - endif - - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + read(cvalue,*) flds_scalar_index_nx + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) flds_scalar_index_ny - write(logmsg,*) flds_scalar_index_ny - call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNY') - endif - - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + read(cvalue,*) flds_scalar_index_ny + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) flds_scalar_index_nextsw_cday - write(logmsg,*) flds_scalar_index_nextsw_cday - call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nextsw_cday = '//trim(logmsg), ESMF_LOGMSG_INFO) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxNextSwCday') - endif - - call NUOPC_CompAttributeGet(gcomp, name='ROF_model', value=cvalue, rc=rc) + read(cvalue,*) flds_scalar_index_nextsw_cday + call NUOPC_CompAttributeGet(gcomp, name='ROF_model', value=rof_model, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(cvalue) == 'srof' .or. trim(cvalue) == 'drof') then + if (trim(rof_model) == 'srof' .or. trim(rof_model) == 'drof') then rof_prognostic = .false. else rof_prognostic = .true. end if - - call NUOPC_CompAttributeGet(gcomp, name='GLC_model', value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='ATM_model', value=atm_model, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(cvalue) == 'sglc') then + if (trim(atm_model) == 'satm' .or. trim(atm_model) == 'datm') then + atm_prognostic = .false. + else + atm_prognostic = .true. + end if + call NUOPC_CompAttributeGet(gcomp, name='GLC_model', value=glc_model, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(glc_model) == 'sglc') then glc_present = .false. else glc_present = .true. - cism_evolve = .true. - call NUOPC_CompAttributeGet(gcomp, name="cism_evolve", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + end if + if (.not. glc_present) then + cism_evolve = .false. + else + call NUOPC_CompAttributeGet(gcomp, name="cism_evolve", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - call ESMF_LogWrite(trim(subname)//' cism_evolve = '//trim(cvalue), ESMF_LOGMSG_INFO) - if (trim(cvalue) .eq. '.true.') then - cism_evolve = .true. - else if (trim(cvalue) .eq. '.false.') then - cism_evolve = .false. - else - call shr_sys_abort(subname//'Could not determine cism_evolve value '//trim(cvalue)) - endif + if (trim(cvalue) == '.true.') then + cism_evolve = .true. + else if (trim(cvalue) == '.false.') then + cism_evolve = .false. else - call shr_sys_abort(subname//'Need to set cism_evolve if glc is present') + call shr_sys_abort(subname//'Could not determine cism_evolve value '//trim(cvalue)) endif end if if (masterproc) then - write(iulog,*)' rof_prognostic = ',rof_prognostic - write(iulog,*)' glc_present = ',glc_present - if (glc_present) write(iulog,*)' cism_evolve = ',cism_evolve + write(iulog,'(a )')' atm component = '//trim(atm_model) + write(iulog,'(a )')' rof component = '//trim(rof_model) + write(iulog,'(a )')' glc component = '//trim(glc_model) + write(iulog,'(a,L2)')' atm_prognostic = ',atm_prognostic + write(iulog,'(a,L2)')' rof_prognostic = ',rof_prognostic + write(iulog,'(a,L2)')' glc_present = ',glc_present + if (glc_present) then + write(iulog,'(a,L2)')' cism_evolve = ',cism_evolve + end if + write(iulog,'(a )')' flds_scalar_name = '//trim(flds_scalar_name) + write(iulog,'(a,i8)')' flds_scalar_num = ',flds_scalar_num + write(iulog,'(a,i8)')' flds_scalar_index_nx = ',flds_scalar_index_nx + write(iulog,'(a,i8)')' flds_scalar_index_ny = ',flds_scalar_index_ny + write(iulog,'(a,i8)')' flds_scalar_index_nextsw_cday = ',flds_scalar_index_nextsw_cday end if - call advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, rof_prognostic, rc) + call advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, rof_prognostic, atm_prognostic, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- @@ -328,15 +310,22 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call shr_file_setLogUnit (shrlogunit) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) + end subroutine InitializeAdvertise !=============================================================================== - subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) - use clm_instMod, only : lnd2atm_inst, lnd2glc_inst, water_inst -!$ use omp_lib, only : omp_set_num_threads - use ESMF, only : ESMF_VM, ESMF_VMGet + ! Realize the list of fields that will be exchanged + !$ use omp_lib, only : omp_set_num_threads + use ESMF , only : ESMF_VM, ESMF_VMGet + use clm_instMod , only : lnd2atm_inst, lnd2glc_inst, water_inst + use domainMod , only : ldomain + use decompMod , only : ldecomp, bounds_type, get_proc_bounds + use lnd_set_decomp_and_domain , only : lnd_set_decomp_and_domain_from_readmesh + use lnd_set_decomp_and_domain , only : lnd_set_mesh_for_single_column + use lnd_set_decomp_and_domain , only : lnd_set_decomp_and_domain_for_single_column + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState @@ -345,14 +334,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables - type(ESMF_Mesh) :: gridmesh ! temporary esmf mesh - type(ESMF_DistGrid) :: DistGrid ! esmf global index space descriptor - type(ESMF_VM) :: vm + type(ESMF_VM) :: vm ! Virtual machine, description of parallel procesors being used (both MPI and OpenMP) type(ESMF_Time) :: currTime ! Current time type(ESMF_Time) :: startTime ! Start time type(ESMF_Time) :: refTime ! Ref time type(ESMF_TimeInterval) :: timeStep ! Model timestep - type(ESMF_Calendar) :: esmf_calendar ! esmf calendar type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type integer :: ref_ymd ! reference date (YYYYMMDD) integer :: ref_tod ! reference time of day (sec) @@ -362,47 +348,36 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: curr_ymd ! Start date (YYYYMMDD) integer :: curr_tod ! Start time of day (sec) integer :: dtime_sync ! coupling time-step from the input synchronization clock - integer :: localPet - integer :: localpecount - integer, pointer :: gindex(:) ! global index space for land and ocean points - integer, pointer :: gindex_lnd(:) ! global index space for just land points - integer, pointer :: gindex_ocn(:) ! global index space for just ocean points - integer, pointer :: mask(:) ! local land/ocean mask - character(ESMF_MAXSTR) :: cvalue ! config data - integer :: nlnd, nocn ! local size ofarrays - integer :: g,n ! indices - 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=CL) :: caseid ! case identifier name - character(len=CL) :: ctitle ! case description title + integer :: localPet ! local PET (Persistent Execution Threads) (both MPI tasks and OpenMP threads) + integer :: localPeCount ! Number of local Processors character(len=CL) :: starttype ! start-type (startup, continue, branch, hybrid) character(len=CL) :: calendar ! calendar type name - character(len=CL) :: hostname ! hostname of machine running on - character(len=CL) :: model_version ! Model version - character(len=CL) :: username ! user running the model - integer :: nsrest ! ctsm restart type logical :: brnch_retain_casename ! flag if should retain the case name on a branch start type + integer :: nsrest ! ctsm restart type integer :: lbnum ! input to memory diagnostic - type(bounds_type) :: bounds ! bounds integer :: shrlogunit ! original log unit - real(r8) :: mesh_lon, mesh_lat, mesh_area - real(r8) :: tolerance_latlon = 1.e-5 - real(r8) :: tolerance_area = 1.e-3 - integer :: spatialDim - integer :: numOwnedElements - real(R8), pointer :: ownedElemCoords(:) - real(r8), pointer :: areaPtr(:) - type(ESMF_Field) :: areaField - integer :: dimid_ni, dimid_nj, dimid_nv - integer :: ncid, ierr - integer :: ni, nj, nv - integer :: varid_xv, varid_yv - real(r8), allocatable :: xv(:,:,:), yv(:,:,:) - integer :: maxIndex(2) - real(r8) :: mincornerCoord(2) - real(r8) :: maxcornerCoord(2) - type(ESMF_Grid) :: lgrid + type(bounds_type) :: bounds ! bounds + integer :: n, ni, nj ! Indices + character(len=CL) :: cvalue ! config data + character(len=CL) :: meshfile_mask ! filename of mesh file with land mask + character(len=CL) :: ctitle ! case description title + character(len=CL) :: caseid ! case identifier name + real(r8) :: scol_lat ! single-column latitude + real(r8) :: scol_lon ! single-column longitude + real(r8) :: scol_area ! single-column area + real(r8) :: scol_frac ! single-column frac + integer :: scol_mask ! single-column mask + real(r8) :: scol_spval ! single-column special value to indicate it isn't set + character(len=CL) :: single_column_lnd_domainfile ! domain filename to use for single-column mode (i.e. SCAM) + type(ESMF_Field) :: lfield ! Land field read in + character(CL) ,pointer :: lfieldnamelist(:) => null() ! Land field namelist item sent with land field + integer :: fieldCount ! Number of fields on export state + integer :: rank ! Rank of field (1D or 2D) + real(r8), pointer :: fldptr1d(:) ! 1D field pointer + real(r8), pointer :: fldptr2d(:,:) ! 2D field pointer + character(len=CL) :: model_version ! Model version + character(len=CL) :: hostname ! hostname of machine running on + character(len=CL) :: username ! user running the model character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- @@ -410,107 +385,139 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- - ! Reset shr logging to my log file + ! Single column logic - if mask is zero for nearest neighbor search then + ! set all export state fields to zero and return !---------------------------------------------------------------------------- - call shr_file_getLogUnit (shrlogunit) - call shr_file_setLogUnit (iulog) -#if (defined _MEMTRACE) - if (masterproc) then - lbnum=1 - call memmon_dump_fort('memmon.out','lnd_comp_nuopc_InitializeRealize:start::',lbnum) - endif -#endif - - call ESMF_GridCompGet(gcomp, vm=vm, localPet=localPet, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, pet=localPet, peCount=localPeCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - -!$ call omp_set_num_threads(localPeCount) - - !---------------------- - ! Obtain attribute values - !---------------------- - - call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) caseid - ctitle= trim(caseid) + ! If single_column is true - used single_column_domainfile to + ! obtain nearest neighbor values for scol_lon and scol_lat + ! If single_column is false and scol_lon and scol_lat are not equal to scol_spval then + ! use scol_lon and scol_lat directly - call NUOPC_CompAttributeGet(gcomp, name='scmlon', value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='scol_lon', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scmlon - - call NUOPC_CompAttributeGet(gcomp, name='scmlat', value=cvalue, rc=rc) + read(cvalue,*) scol_lon + call NUOPC_CompAttributeGet(gcomp, name='scol_lat', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) scmlat - - call NUOPC_CompAttributeGet(gcomp, name='single_column', value=cvalue, rc=rc) + read(cvalue,*) scol_lat + call NUOPC_CompAttributeGet(gcomp, name='single_column_lnd_domainfile', value=single_column_lnd_domainfile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) single_column - call NUOPC_CompAttributeGet(gcomp, name='brnch_retain_casename', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) brnch_retain_casename + ! TODO: there is a problem retrieving scol_spval from the driver - for now + ! hard-wire scol_spval - this needs to be fixed + scol_spval = -999._r8 + ! call NUOPC_CompAttributeGet(gcomp, name='scol_spval', value=cvalue, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) scol_spval - call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) starttype + if (scol_lon > scol_spval .and. scol_lat > scol_spval) then + single_column = (trim(single_column_lnd_domainfile) /= 'UNSET') - call NUOPC_CompAttributeGet(gcomp, name='model_version', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) model_version + call NUOPC_CompAttributeGet(gcomp, name='scol_lndmask', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scol_mask - call NUOPC_CompAttributeGet(gcomp, name='hostname', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) hostname + call NUOPC_CompAttributeGet(gcomp, name='scol_lndfrac', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scol_frac - call NUOPC_CompAttributeGet(gcomp, name='username', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) username + call lnd_set_mesh_for_single_column(scol_lon, scol_lat, mesh, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - !TODO: the following strings must not be hard-wired - must have module variables - if ( trim(starttype) == trim('startup')) then - nsrest = nsrStartup - else if (trim(starttype) == trim('continue') ) then - nsrest = nsrContinue - else if (trim(starttype) == trim('branch')) then - nsrest = nsrBranch + scol_valid = (scol_mask == 1) + if (.not. scol_valid) then + write(iulog,'(a)')' single column mode point does not contain any land - will set all export data to 0' + ! if single column is not valid - set all export state fields to zero and return + call realize_fields(importState, exportState, mesh, flds_scalar_name, flds_scalar_num, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_StateGet(exportState, itemCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + call ESMF_StateGet(exportState, itemNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1, fieldCount + if (trim(lfieldnamelist(n)) /= flds_scalar_name) then + call ESMF_StateGet(exportState, itemName=trim(lfieldnamelist(n)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, rank=rank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (rank == 2) then + call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr2d(:,:) = 0._r8 + else + call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + end if + end if + enddo + deallocate(lfieldnamelist) + ! ******************* + ! *** RETURN HERE *** + ! ******************* + RETURN + else + write(iulog,'(a,3(f10.5,2x))')' single column mode scol_lon/scol_lat/scol_frac is ',& + scol_lon,scol_lat,scol_frac + end if else - call shr_sys_abort( subname//' ERROR: unknown starttype' ) + single_column = .false. end if + !---------------------------------------------------------------------------- + ! Reset shr logging to my log file + !---------------------------------------------------------------------------- + + call shr_file_getLogUnit (shrlogunit) + call shr_file_setLogUnit (iulog) +#if (defined _MEMTRACE) + if (masterproc) then + lbnum=1 + call memmon_dump_fort('memmon.out','lnd_comp_nuopc_InitializeRealize:start::',lbnum) + endif +#endif + !---------------------------------------------------------------------------- + ! Initialize component threading + !---------------------------------------------------------------------------- + + call ESMF_GridCompGet(gcomp, vm=vm, localPet=localPet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, pet=localPet, peCount=localPeCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if(localPeCount == 1) then + call NUOPC_CompAttributeGet(gcomp, "nthreads", value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + read(cvalue,*) nthrds + else + nthrds = localPeCount + endif + + !$ call omp_set_num_threads(nthrds) + !---------------------- ! Consistency check on namelist filename !---------------------- - call control_setNL("lnd_in"//trim(inst_suffix)) !---------------------- ! Get properties from clock !---------------------- - - call ESMF_ClockGet( clock, & - currTime=currTime, startTime=startTime, refTime=RefTime, & + call ESMF_ClockGet( clock, currTime=currTime, startTime=startTime, refTime=RefTime, & timeStep=timeStep, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet( currTime, yy=yy, mm=mm, dd=dd, s=curr_tod, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yy,mm,dd,curr_ymd) - call ESMF_TimeGet( startTime, yy=yy, mm=mm, dd=dd, s=start_tod, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yy,mm,dd,start_ymd) - call ESMF_TimeGet( refTime, yy=yy, mm=mm, dd=dd, s=ref_tod, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yy,mm,dd,ref_ymd) - call ESMF_TimeGet( currTime, calkindflag=esmf_caltype, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (esmf_caltype == ESMF_CALKIND_NOLEAP) then calendar = shr_cal_noleap else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then @@ -518,10 +525,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) else call shr_sys_abort( subname//'ERROR:: bad calendar for ESMF' ) end if - call ESMF_TimeIntervalGet( timeStep, s=dtime_sync, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (masterproc) then write(iulog,*)'dtime = ', dtime_sync end if @@ -529,16 +534,21 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------- ! Initialize module orbital values and update orbital !---------------------- - call clm_orbital_init(gcomp, iulog, masterproc, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call clm_orbital_update(clock, iulog, masterproc, eccen, obliqr, lambm0, mvelpp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------- ! Initialize CTSM time manager !---------------------- + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) caseid + ctitle= trim(caseid) + call NUOPC_CompAttributeGet(gcomp, name='model_version', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) model_version ! Note that we assume that CTSM's internal dtime matches the coupling time step. ! i.e., we currently do NOT allow sub-cycling within a coupling time step. @@ -550,225 +560,88 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ref_tod_in=ref_tod, & dtime_in=dtime_sync) - !---------------------------------------------------------------------------- ! Set model clock in lnd_comp_shr - !---------------------------------------------------------------------------- - model_clock = clock - !---------------------- - ! Read namelist, grid and surface data - !---------------------- + ! --------------------- + ! Initialize first phase of ctsm + ! --------------------- + call NUOPC_CompAttributeGet(gcomp, name='hostname', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) hostname + call NUOPC_CompAttributeGet(gcomp, name='username', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) username + call NUOPC_CompAttributeGet(gcomp, name='brnch_retain_casename', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) brnch_retain_casename + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) starttype + + if ( trim(starttype) == trim(startup_run)) then + nsrest = nsrStartup + else if (trim(starttype) == trim(continue_run)) then + nsrest = nsrContinue + else if (trim(starttype) == trim(branch_run)) then + nsrest = nsrBranch + else + call shr_sys_abort( subname//' ERROR: unknown starttype' ) + end if ! set default values for run control variables 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, & + single_column_in=single_column, scmlat_in=scol_lat, scmlon_in=scol_lon, & nsrest_in=nsrest, & version_in=model_version, & hostname_in=hostname, & username_in=username) - ! note that the memory for gindex_ocn will be allocated in the following call - call initialize1(dtime=dtime_sync, gindex_ocn=gindex_ocn) - - ! If no land then abort for now - ! TODO: need to handle the case of noland with CMEPS - ! if ( noland ) then - ! call shr_sys_abort(trim(subname)//"ERROR: Currently cannot handle case of single column with non-land") - ! end if - - ! obtain global index array for just land points which includes mask=0 or ocean points - call get_proc_bounds( bounds ) - nlnd = bounds%endg - bounds%begg + 1 - allocate(gindex_lnd(nlnd)) - do g = bounds%begg,bounds%endg - n = 1 + (g - bounds%begg) - gindex_lnd(n) = ldecomp%gdc2glo(g) - end do - - ! create a global index that includes both land and ocean points - nocn = size(gindex_ocn) - allocate(gindex(nlnd + nocn)) - allocate(mask(nlnd + nocn)) - do n = 1,nlnd+nocn - if (n <= nlnd) then - gindex(n) = gindex_lnd(n) - mask(n) = 1 - else - gindex(n) = gindex_ocn(n-nlnd) - mask(n) = 0 - end if - end do - - ! create distGrid from global index array - DistGrid = ESMF_DistGridCreate(arbSeqIndexList=gindex, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - deallocate(gindex) - - !-------------------------------- - ! generate the mesh and realize fields - !-------------------------------- - - ! determine if the mesh will be created or read in - call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=model_meshfile, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (single_column) model_meshfile = 'create_mesh' + call initialize1(dtime=dtime_sync) - if (trim(model_meshfile) == 'create_mesh') then - ! get the datm grid from the domain file - call NUOPC_CompAttributeGet(gcomp, name='domain_lnd', value=cvalue, rc=rc) + ! --------------------- + ! Create ctsm decomp and domain info + ! --------------------- + if (scol_lon > scol_spval .and. scol_lat > scol_spval) then + call lnd_set_decomp_and_domain_for_single_column(scol_lon, scol_lat, scol_mask, scol_frac) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! open file - ierr = nf90_open(cvalue, NF90_NOWRITE, ncid) - call nc_check_err(ierr, 'nf90_open', trim(cvalue)) - ! get dimension ids - ierr = nf90_inq_dimid(ncid, 'ni', dimid_ni) - call nc_check_err(ierr, 'nf90_inq_dimid for ni', trim(cvalue)) - ierr = nf90_inq_dimid(ncid, 'nj', dimid_nj) - call nc_check_err(ierr, 'nf90_inq_dimid for nj', trim(cvalue)) - ierr = nf90_inq_dimid(ncid, 'nv', dimid_nv) - call nc_check_err(ierr, 'nf90_inq_dimid for nv', trim(cvalue)) - ! get dimension values - ierr = nf90_inquire_dimension(ncid, dimid_ni, len=ni) - call nc_check_err(ierr, 'nf90_inq_dimension for ni', trim(cvalue)) - ierr = nf90_inquire_dimension(ncid, dimid_nj, len=nj) - call nc_check_err(ierr, 'nf90_inq_dimension for nj', trim(cvalue)) - ierr = nf90_inquire_dimension(ncid, dimid_nv, len=nv) - call nc_check_err(ierr, 'nf90_inq_dimension for nv', trim(cvalue)) - ! get variable ids - ierr = nf90_inq_varid(ncid, 'xv', varid_xv) - call nc_check_err(ierr, 'nf90_inq_varid for xv', trim(cvalue)) - ierr = nf90_inq_varid(ncid, 'yv', varid_yv) - call nc_check_err(ierr, 'nf90_inq_varid for yv', trim(cvalue)) - ! allocate memory for variables and get variable values - allocate(xv(nv,ni,nj), yv(nv,ni,nj)) - ierr = nf90_get_var(ncid, varid_xv, xv) - call nc_check_err(ierr, 'nf90_get_var for xv', trim(cvalue)) - ierr = nf90_get_var(ncid, varid_yv, yv) - call nc_check_err(ierr, 'nf90_get_var for yv', trim(cvalue)) - ! close file - ierr = nf90_close(ncid) - call nc_check_err(ierr, 'nf90_close', trim(cvalue)) - ! create the grid - maxIndex(1) = ni ! number of lons - maxIndex(2) = nj ! number of lats - mincornerCoord(1) = xv(1,1,1) ! min lon - mincornerCoord(2) = yv(1,1,1) ! min lat - maxcornerCoord(1) = xv(3,ni,nj) ! max lon - maxcornerCoord(2) = yv(3,ni,nj) ! max lat - deallocate(xv,yv) - lgrid = ESMF_GridCreateNoPeriDimUfrm (maxindex=maxindex, & - mincornercoord=mincornercoord, maxcornercoord= maxcornercoord, & - staggerloclist=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! create the mesh from the grid - mesh = ESMF_MeshCreate(lgrid, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! TODO: is the mask by default set to 1 if created from a grid? - ! reset the global mask (which is 1) to the land/ocean mask - ! - ! Currently, this call requires that the information has - ! already been added to the mesh during creation. For example, - ! you can only change the element mask information, if the mesh - ! was initially created with element masking. - !!! call ESMF_MeshSet(mesh, elementMask=mask, rc=rc) - !!! if (ChkErr(rc,__LINE__,u_FILE_u)) return - - deallocate(mask) - else - - ! read in the mesh from the file - mesh = ESMF_MeshCreate(filename=trim(model_meshfile), fileformat=ESMF_FILEFORMAT_ESMFMESH, & - elementDistgrid=Distgrid, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=model_meshfile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (masterproc) then - write(iulog,*)'mesh file for domain is ',trim(model_meshfile) - end if - - ! Determine the areas on the mesh - areaField = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name='mesh_areas', meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='mesh_mask', value=meshfile_mask, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldRegridGetArea(areaField, rc=rc) + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(areaField, farrayPtr=areaPtr, rc=rc) + call lnd_set_decomp_and_domain_from_readmesh(driver='cmeps', vm=vm, & + meshfile_lnd=model_meshfile, meshfile_mask=meshfile_mask, mesh_ctsm=mesh, ni=ni, nj=nj, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - ! realize the actively coupled fields - call realize_fields(gcomp, mesh, flds_scalar_name, flds_scalar_num, rc) + ! --------------------- + ! Realize the actively coupled fields + ! --------------------- + call realize_fields(importState, exportState, mesh, flds_scalar_name, flds_scalar_num, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !-------------------------------- + ! --------------------- ! Finish initializing ctsm - !-------------------------------- - - call initialize2() - - !-------------------------------- - ! Check that lats, lons and areas on mesh are the same as those internal to ctsm - ! obtain mesh lats and lons - !-------------------------------- - - if (trim(model_meshfile) /= 'create_mesh') then - call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(ownedElemCoords(spatialDim*numOwnedElements)) - call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do g = bounds%begg,bounds%endg - n = 1 + (g - bounds%begg) - mesh_lon = ownedElemCoords(2*n-1) - mesh_lat = ownedElemCoords(2*n) - mesh_area = areaPtr(n) - if (abs(mesh_lon - ldomain%lonc(g)) > tolerance_latlon) then - write(6,100)'ERROR: clm_lon, mesh_lon, diff_lon = ',& - ldomain%lonc(g), mesh_lon, abs(mesh_lon - ldomain%lonc(g)) - !call shr_sys_abort() - end if - if (abs(mesh_lat - ldomain%latc(g)) > tolerance_latlon) then - write(6,100)'ERROR: clm_lat, mesh_lat, diff_lat = ',& - ldomain%latc(g), mesh_lat, abs(mesh_lat - ldomain%latc(g)) - !call shr_sys_abort() - end if - if (abs(mesh_area - ldomain%area(g)/(re*re)) > tolerance_area) then - write(6,100)'ERROR: clm_area, mesh_area, diff_area = ',& - ldomain%area(g)/(re*re), mesh_area, abs(mesh_area - ldomain%area(g)/(re*re)) - !call shr_sys_abort() - end if - end do -100 format(a,3(d13.5,2x)) - end if + ! --------------------- + call initialize2(ni, nj) !-------------------------------- ! Create land export state !-------------------------------- - + call get_proc_bounds(bounds) call export_fields(gcomp, bounds, glc_present, rof_prognostic, & water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Get calendar day of nextsw calculation - if (nsrest == nsrStartup) then - call ESMF_ClockGet( clock, currTime=currTime, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - call set_nextsw_cday(nextsw_cday) - ! Set scalars in export state call State_SetScalar(dble(ldomain%ni), flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call State_SetScalar(dble(ldomain%nj), flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -805,9 +678,11 @@ subroutine ModelAdvance(gcomp, rc) ! Run CTSM !------------------------ - use clm_instMod, only : water_inst, atm2lnd_inst, glc2lnd_inst, lnd2atm_inst, lnd2glc_inst !$ use omp_lib, only : omp_set_num_threads - use ESMF, only : ESMF_VM, ESMF_VMGet + use ESMF , only : ESMF_VM, ESMF_VMGet + use clm_instMod , only : water_inst, atm2lnd_inst, glc2lnd_inst, lnd2atm_inst, lnd2glc_inst + use decompMod , only : bounds_type, get_proc_bounds + use clm_driver , only : clm_drv ! input/output variables type(ESMF_GridComp) :: gcomp @@ -834,8 +709,8 @@ subroutine ModelAdvance(gcomp, rc) integer :: tod_sync ! Sync current time of day (sec) integer :: dtime ! time step increment (sec) integer :: nstep ! time step index - integer :: localPet - integer :: localpecount + integer :: localPet ! local PET (Persistent Execution Threads) (both MPI tasks and OpenMP threads) + integer :: localPeCount ! Number of local Processors logical :: rstwr ! .true. ==> write restart file before returning logical :: nlend ! .true. ==> last time-step logical :: dosend ! true => send data back to driver @@ -857,12 +732,19 @@ subroutine ModelAdvance(gcomp, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - call ESMF_GridCompGet(gcomp, vm=vm, localPet=localPet, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, pet=localPet, peCount=localPeCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + !-------------------------------- + ! Single column logic if nearest neighbor point has a mask of zero + !-------------------------------- - !$ call omp_set_num_threads(localPeCount) + if (single_column .and. .not. scol_valid) then + RETURN + end if + + !$ call omp_set_num_threads(nthrds) + + !-------------------------------- + ! Reset share log units + !-------------------------------- call shr_file_getLogUnit (shrlogunit) call shr_file_setLogUnit (iulog) @@ -875,7 +757,7 @@ subroutine ModelAdvance(gcomp, rc) #endif !-------------------------------- - ! Query the Component for its clock, importState and exportState + ! Query the Component for its clock, importState and exportState and vm !-------------------------------- call NUOPC_ModelGet(gcomp, modelClock=clock, importState=importState, exportState=exportState, rc=rc) @@ -888,24 +770,18 @@ subroutine ModelAdvance(gcomp, rc) call State_GetScalar(importState, & flds_scalar_index_nextsw_cday, nextsw_cday, & flds_scalar_name, flds_scalar_num, rc) - call set_nextsw_cday( nextsw_cday ) - - !---------------------- - ! Get orbital values - !---------------------- + ! Get proc bounds + call get_proc_bounds(bounds) !-------------------------------- ! Unpack import state !-------------------------------- call t_startf ('lc_lnd_import') - - call get_proc_bounds(bounds) call import_fields( gcomp, bounds, glc_present, rof_prognostic, & atm2lnd_inst, glc2lnd_inst, water_inst%wateratm2lndbulk_inst, rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf ('lc_lnd_import') !-------------------------------- @@ -974,32 +850,27 @@ subroutine ModelAdvance(gcomp, rc) ! Run CTSM !-------------------------------- - call t_barrierf('sync_ctsm_run1', mpicom) + ! call ESMF_VMBarrier(vm, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_startf ('shr_orb_decl') - ! Note - the orbital inquiries set the values in clm_varorb via the module use statements call clm_orbital_update(clock, iulog, masterproc, eccen, obliqr, lambm0, mvelpp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - 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 t_startf ('ctsm_run') - ! Restart File - use nexttimestr rather than currtimestr here since that is the time at the end of ! the timestep and is preferred for restart file names - call ESMF_ClockGetNextTime(clock, nextTime=nextTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(nexttime, yy=yr_sync, mm=mon_sync, dd=day_sync, s=tod_sync, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(rdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr_sync, mon_sync, day_sync, tod_sync - call clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, rof_prognostic) - call t_stopf ('ctsm_run') !-------------------------------- @@ -1007,11 +878,9 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call t_startf ('lc_lnd_export') - call export_fields(gcomp, bounds, glc_present, rof_prognostic, & water_inst%waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_stopf ('lc_lnd_export') !-------------------------------- @@ -1079,7 +948,6 @@ subroutine ModelAdvance(gcomp, rc) end subroutine ModelAdvance !=============================================================================== - subroutine ModelSetRunClock(gcomp, rc) type(ESMF_GridComp) :: gcomp @@ -1203,7 +1071,6 @@ subroutine ModelSetRunClock(gcomp, rc) end subroutine ModelSetRunClock !=============================================================================== - subroutine ModelFinalize(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -1232,7 +1099,6 @@ subroutine ModelFinalize(gcomp, rc) end subroutine ModelFinalize !=============================================================================== - subroutine clm_orbital_init(gcomp, logunit, mastertask, rc) !---------------------------------------------------------- @@ -1332,7 +1198,6 @@ subroutine clm_orbital_init(gcomp, logunit, mastertask, rc) end subroutine clm_orbital_init !=============================================================================== - subroutine clm_orbital_update(clock, logunit, mastertask, eccen, obliqr, lambm0, mvelpp, rc) !---------------------------------------------------------- @@ -1388,18 +1253,4 @@ subroutine clm_orbital_update(clock, logunit, mastertask, eccen, obliqr, lambm0 end subroutine clm_orbital_update - !=============================================================================== - - subroutine nc_check_err(ierror, description, filename) - integer , intent(in) :: ierror - character(*), intent(in) :: description - character(*), intent(in) :: filename - - if (ierror /= nf90_noerr) then - write (*,'(6a)') 'ERROR ', trim(description),'. NetCDF file : "', trim(filename),& - '". Error message:', trim(nf90_strerror(ierror)) - call shr_sys_abort() - endif - end subroutine nc_check_err - end module lnd_comp_nuopc diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index 346e4f6e7f..f4e0759ae1 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -1,30 +1,27 @@ module lnd_import_export - - use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Mesh, ESMF_StateGet - use ESMF , only : ESMF_KIND_R8, ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGMSG_INFO - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LogFoundError - use ESMF , only : ESMF_STATEITEM_NOTFOUND, ESMF_StateItem_Flag - use ESMF , only : operator(/=), operator(==) - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise, NUOPC_IsConnected - use NUOPC_Model , only : NUOPC_ModelGet - use shr_kind_mod , only : r8 => shr_kind_r8, cx=>shr_kind_cx, cxx=>shr_kind_cxx, cs=>shr_kind_cs - use shr_sys_mod , only : shr_sys_abort - use clm_varctl , only : iulog - use clm_time_manager , only : get_nstep - 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 domainMod , only : ldomain - use spmdMod , only : masterproc - use seq_drydep_mod , only : seq_drydep_readnl, n_drydep - use shr_megan_mod , only : shr_megan_readnl, shr_megan_mechcomps_n - use shr_fire_emis_mod , only : shr_fire_emis_readnl - use shr_carma_mod , only : shr_carma_readnl - use shr_ndep_mod , only : shr_ndep_readnl - use nuopc_shr_methods , only : chkerr - use lnd_import_export_utils, only : derive_quantities, check_for_errors, check_for_nans + ! CTSM import and export fields exchanged with the coupler + use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Mesh, ESMF_StateGet + use ESMF , only : ESMF_KIND_R8, ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LogFoundError + use ESMF , only : ESMF_STATEITEM_NOTFOUND, ESMF_StateItem_Flag + use ESMF , only : operator(/=), operator(==) + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise, NUOPC_IsConnected + use NUOPC_Model , only : NUOPC_ModelGet + use shr_kind_mod , only : r8 => shr_kind_r8, cx=>shr_kind_cx, cxx=>shr_kind_cxx, cs=>shr_kind_cs + use shr_sys_mod , only : shr_sys_abort + use clm_varctl , only : iulog + use clm_time_manager , only : get_nstep + use decompmod , only : bounds_type, get_proc_bounds + use lnd2atmType , only : lnd2atm_type + use lnd2glcMod , only : lnd2glc_type + use atm2lndType , only : atm2lnd_type + use glc2lndMod , only : glc2lnd_type + use domainMod , only : ldomain + use spmdMod , only : masterproc + use seq_drydep_mod , only : seq_drydep_readnl, n_drydep + use shr_megan_mod , only : shr_megan_readnl, shr_megan_mechcomps_n + use nuopc_shr_methods , only : chkerr + use lnd_import_export_utils , only : check_for_errors, check_for_nans implicit none private ! except @@ -36,9 +33,12 @@ module lnd_import_export private :: fldlist_add private :: fldlist_realize - private :: state_getimport - private :: state_setexport + private :: state_getimport_1d + private :: state_getimport_2d + private :: state_setexport_1d + private :: state_setexport_2d private :: state_getfldptr + private :: fldchk type fld_list_type character(len=128) :: stdname @@ -51,7 +51,6 @@ module lnd_import_export integer :: fldsFrLnd_num = 0 type (fld_list_type) :: fldsToLnd(fldsMax) type (fld_list_type) :: fldsFrLnd(fldsMax) - integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost ! from atm->lnd integer :: ndep_nflds ! number of nitrogen deposition fields from atm->lnd/ocn @@ -68,6 +67,80 @@ module lnd_import_export integer :: glc_nec ! number of glc elevation classes integer, parameter :: debug = 0 ! internal debug level + ! import fields + character(*), parameter :: Sa_z = 'Sa_z' + character(*), parameter :: Sa_topo = 'Sa_topo' + character(*), parameter :: Sa_u = 'Sa_u' + character(*), parameter :: Sa_v = 'Sa_v' + character(*), parameter :: Sa_ptem = 'Sa_ptem' + character(*), parameter :: Sa_shum = 'Sa_shum' + character(*), parameter :: Sa_pbot = 'Sa_pbot' + character(*), parameter :: Sa_tbot = 'Sa_tbot' + character(*), parameter :: Faxa_rainc = 'Faxa_rainc' + character(*), parameter :: Faxa_rainl = 'Faxa_rainl' + character(*), parameter :: Faxa_snowc = 'Faxa_snowc' + character(*), parameter :: Faxa_snowl = 'Faxa_snowl' + character(*), parameter :: Faxa_lwdn = 'Faxa_lwdn' + character(*), parameter :: Faxa_swvdr = 'Faxa_swvdr' + character(*), parameter :: Faxa_swndr = 'Faxa_swndr' + character(*), parameter :: Faxa_swvdf = 'Faxa_swvdf' + character(*), parameter :: Faxa_swndf = 'Faxa_swndf' + character(*), parameter :: Faxa_bcph = 'Faxa_bcph' + character(*), parameter :: Faxa_ocph = 'Faxa_ocph' + character(*), parameter :: Faxa_dstwet = 'Faxa_dstwet' + character(*), parameter :: Faxa_dstdry = 'Faxa_dstdry' + character(*), parameter :: Sa_methane = 'Sa_methaneaxa_ndep' + character(*), parameter :: Faxa_ndep = 'Faxa_ndep' + character(*), parameter :: Sa_co2prog = 'Sa_co2prog' + character(*), parameter :: Sa_co2diag = 'Sa_co2diag' + character(*), parameter :: Flrr_flood = 'Flrr_flood' + character(*), parameter :: Flrr_volr = 'Flrr_volr' + character(*), parameter :: Flrr_volrmch = 'Flrr_volrmch' + character(*), parameter :: Sg_ice_covered_elev = 'Sg_ice_covered_elev' + character(*), parameter :: Sg_topo_elev = 'Sg_topo_elev' + character(*), parameter :: Flgg_hflx_elev = 'Flgg_hflx_elev' + character(*), parameter :: Sg_icemask = 'Sg_icemask' + character(*), parameter :: Sg_icemask_coupled_fluxes = 'Sg_icemask_coupled_fluxes' + + ! export fields + character(*), parameter :: Sl_lfrin = 'Sl_lfrin' + character(*), parameter :: Sl_t = 'Sl_t' + character(*), parameter :: Sl_snowh = 'Sl_snowh' + character(*), parameter :: Sl_avsdr = 'Sl_avsdr' + character(*), parameter :: Sl_anidr = 'Sl_anidr' + character(*), parameter :: Sl_avsdf = 'Sl_avsdf' + character(*), parameter :: Sl_anidf = 'Sl_anidf' + character(*), parameter :: Sl_tref = 'Sl_tref' + character(*), parameter :: Sl_qref = 'Sl_qref' + character(*), parameter :: Fall_taux = 'Fall_taux' + character(*), parameter :: Fall_tauy = 'Fall_tauy' + character(*), parameter :: Fall_lat = 'Fall_lat' + character(*), parameter :: Fall_sen = 'Fall_sen' + character(*), parameter :: Fall_lwup = 'Fall_lwup' + character(*), parameter :: Fall_evap = 'Fall_evap' + character(*), parameter :: Fall_swnet = 'Fall_swnet' + character(*), parameter :: Fall_flxdst = 'Fall_flxdst' + character(*), parameter :: Fall_methane = 'Fall_methane' + character(*), parameter :: Sl_u10 = 'Sl_u10' + character(*), parameter :: Sl_ram1 = 'Sl_ram1' + character(*), parameter :: Sl_fv = 'Sl_fv' + character(*), parameter :: Sl_soilw = 'Sl_soilw' + character(*), parameter :: Fall_fco2_lnd = 'Fall_fco2_lnd' + character(*), parameter :: Sl_ddvel = 'Sl_ddvel' + character(*), parameter :: Fall_voc = 'Fall_voc' + character(*), parameter :: Fall_fire = 'Fall_fire' + character(*), parameter :: Sl_fztop = 'Sl_fztop' + character(*), parameter :: Flrl_rofsur = 'Flrl_rofsur' + character(*), parameter :: Flrl_rofsub = 'Flrl_rofsub' + character(*), parameter :: Flrl_rofgwl = 'Flrl_rofgwl' + character(*), parameter :: Flrl_rofi = 'Flrl_rofi' + character(*), parameter :: Flrl_irrig = 'Flrl_irrig' + character(*), parameter :: Sl_tsrf_elev = 'Sl_tsrf_elev' + character(*), parameter :: Sl_topo_elev = 'Sl_topo_elev' + character(*), parameter :: Flgl_qice_elev = 'Flgl_qice_elev' + + logical :: send_to_atm + character(*),parameter :: F01 = "('(lnd_import_export) ',a,i5,2x,i5,2x,d21.14)" character(*),parameter :: u_FILE_u = & __FILE__ @@ -76,9 +149,12 @@ module lnd_import_export contains !=============================================================================== - subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, rof_prognostic, rc) + subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, rof_prognostic, atm_prognostic, rc) - use clm_varctl, only : ndep_from_cpl + use shr_carma_mod , only : shr_carma_readnl + use shr_ndep_mod , only : shr_ndep_readnl + use shr_fire_emis_mod , only : shr_fire_emis_readnl + use clm_varctl , only : ndep_from_cpl ! input/output variables type(ESMF_GridComp) :: gcomp @@ -86,16 +162,20 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r logical , intent(in) :: glc_present logical , intent(in) :: cism_evolve logical , intent(in) :: rof_prognostic + logical , intent(in) :: atm_prognostic integer , intent(out) :: rc ! local variables - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - character(ESMF_MAXSTR) :: stdname - character(ESMF_MAXSTR) :: cvalue - character(len=2) :: nec_str - integer :: n, num - character(len=128) :: fldname + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + character(len=CS) :: cvalue + integer :: n, num + logical :: send_co2_to_atm = .false. + logical :: recv_co2_fr_atm = .false. + + ! BUG(wjs, 2020-12-22, ESCOMP/CTSM#1237) force_send_to_atm should be read from the + ! namelist rather than being hard-coded to true. + logical, parameter :: force_send_to_atm = .true. character(len=*), parameter :: subname='(lnd_import_export:advertise_fields)' !------------------------------------------------------------------------------- @@ -104,25 +184,6 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r call NUOPC_ModelGet(gcomp, importState=importState, exportState=exportState, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !-------------------------------- - ! determine necessary toggles for below - !-------------------------------- - - call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flds_co2a - call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO) - - call NUOPC_CompAttributeGet(gcomp, name='flds_co2b', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flds_co2b - call ESMF_LogWrite('flds_co2b = '// trim(cvalue), ESMF_LOGMSG_INFO) - - call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flds_co2c - call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO) - ! Determine number of elevation classes call NUOPC_CompAttributeGet(gcomp, name='glc_nec', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -136,84 +197,112 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r ! Advertise export fields !-------------------------------- - call fldlist_add(fldsFrLnd_num, fldsFrlnd, trim(flds_scalar_name)) + ! Need to determine if there is no land for single column before the advertise call is done - ! export land states - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_lfrin' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_t' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_tref' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_qref' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_avsdr' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_anidr' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_avsdf' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_anidf' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_snowh' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_u10' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_fv' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_ram1' ) - - ! export fluxes to river - if (rof_prognostic) then - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofsur' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofgwl' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofsub' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofi' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_irrig' ) + if (atm_prognostic .or. force_send_to_atm) then + send_to_atm = .true. + else + send_to_atm = .false. end if - ! export fluxes to atm - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_taux' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_tauy' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_lat' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_sen' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_lwup' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_evap' ) - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_swnet' ) - - ! call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_methane' ) - - ! dust fluxes from land (4 sizes) - call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Fall_flxdst', ungridded_lbound=1, ungridded_ubound=4) - - ! co2 fields from land - if (flds_co2b .or. flds_co2c) then - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Fall_fco2_lnd' ) + if (send_to_atm) then + call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) flds_co2a + call NUOPC_CompAttributeGet(gcomp, name='flds_co2b', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) flds_co2b + call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) flds_co2c + if (flds_co2b .or. flds_co2c) send_co2_to_atm = .true. + if (flds_co2a .or. flds_co2b .or. flds_co2c) recv_co2_fr_atm = .true. + if (masterproc) then + write(iulog,'(a,L2)') 'flds_co2a= ',flds_co2a + write(iulog,'(a,L2)') 'flds_co2b= ',flds_co2b + write(iulog,'(a,L2)') 'flds_co2c= ',flds_co2c + write(iulog,'(a,L2)') 'sending co2 to atm = ',send_co2_to_atm + write(iulog,'(a,L2)') 'receiving co2 from atm = ',recv_co2_fr_atm + end if end if + ! The following namelist reads should always be called regardless of the send_to_atm value + ! Dry Deposition velocities from land - ALSO initialize drydep here call seq_drydep_readnl("drv_flds_in", drydep_nflds) - if (drydep_nflds > 0) then - call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Sl_ddvel', ungridded_lbound=1, ungridded_ubound=drydep_nflds) - end if + + ! Fire emissions fluxes from land + call shr_fire_emis_readnl('drv_flds_in', emis_nflds) ! MEGAN VOC emissions fluxes from land call shr_megan_readnl('drv_flds_in', megan_nflds) if (shr_megan_mechcomps_n .ne. megan_nflds) call shr_sys_abort('ERROR: megan field count mismatch') - if (shr_megan_mechcomps_n > 0) then - call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Fall_voc', ungridded_lbound=1, ungridded_ubound=megan_nflds) - end if - ! Fire emissions fluxes from land - call shr_fire_emis_readnl('drv_flds_in', emis_nflds) - if (emis_nflds > 0) then - call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Fall_fire', ungridded_lbound=1, ungridded_ubound=emis_nflds) - call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Sl_fztop') - end if ! CARMA volumetric soil water from land ! TODO: is the following correct - the CARMA field exchange is very confusing in mct call shr_carma_readnl('drv_flds_in', carma_fields) - if (carma_fields /= ' ') then - call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_soilw') ! optional for carma + + ! export to atm + call fldlist_add(fldsFrLnd_num, fldsFrlnd, trim(flds_scalar_name)) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_lfrin') + if (send_to_atm) then + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_t ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_tref ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_qref ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_avsdr ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_anidr ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_avsdf ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_anidf ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_snowh ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_u10 ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_fv ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_ram1 ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_taux ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_tauy ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_lat ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_sen ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_lwup ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_evap ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_swnet ) + ! call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_methane ) + ! dust fluxes from land (4 sizes) + call fldlist_add(fldsFrLnd_num, fldsFrLnd, Fall_flxdst, ungridded_lbound=1, ungridded_ubound=4) + if (send_co2_to_atm) then + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Fall_fco2_lnd ) ! co2 fields from land + end if + if (drydep_nflds > 0) then + call fldlist_add(fldsFrLnd_num, fldsFrLnd, Sl_ddvel, ungridded_lbound=1, ungridded_ubound=drydep_nflds) + end if + if (shr_megan_mechcomps_n > 0) then + call fldlist_add(fldsFrLnd_num, fldsFrLnd, Fall_voc, ungridded_lbound=1, ungridded_ubound=megan_nflds) + end if + if (emis_nflds > 0) then + call fldlist_add(fldsFrLnd_num, fldsFrLnd, Fall_fire, ungridded_lbound=1, ungridded_ubound=emis_nflds) + call fldlist_add(fldsFrLnd_num, fldsFrLnd, Sl_fztop) + end if + if (carma_fields /= ' ') then + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_soilw) ! optional for carma + end if + end if + + ! export to rof + if (rof_prognostic) then + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Flrl_rofsur) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Flrl_rofgwl) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Flrl_rofsub) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Flrl_rofi ) + call fldlist_add(fldsFrLnd_num, fldsFrlnd, Flrl_irrig ) end if + ! export to glc if (glc_present .and. cism_evolve) then ! lnd->glc states from land all lnd->glc elevation classes (1:glc_nec) plus bare land (index 0). ! The following puts all of the elevation class fields as an ! undidstributed dimension in the export state field - call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Sl_tsrf_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) - call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Sl_topo_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) - call fldlist_add(fldsFrLnd_num, fldsFrLnd, 'Flgl_qice_elev', ungridded_lbound=1, ungridded_ubound=glc_nec+1) + call fldlist_add(fldsFrLnd_num, fldsFrLnd, Sl_tsrf_elev , ungridded_lbound=1, ungridded_ubound=glc_nec+1) + call fldlist_add(fldsFrLnd_num, fldsFrLnd, Sl_topo_elev , ungridded_lbound=1, ungridded_ubound=glc_nec+1) + call fldlist_add(fldsFrLnd_num, fldsFrLnd, Flgl_qice_elev, ungridded_lbound=1, ungridded_ubound=glc_nec+1) end if ! Now advertise above export fields @@ -229,75 +318,73 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r call fldlist_add(fldsToLnd_num, fldsToLnd, trim(flds_scalar_name)) - ! from atm - states - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_z' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_topo' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_u' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_v' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_ptem' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_pbot' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_tbot' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_shum' ) - !call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_methane' ) - - ! from atm - fluxes - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_lwdn' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_rainc' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_rainl' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_snowc' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_snowl' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_swndr' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_swvdr' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_swndf' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_swvdf' ) + ! from atm + call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_z ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_topo ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_u ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_v ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_ptem ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_pbot ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_tbot ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_shum ) + !call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_methane ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_lwdn ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_rainc ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_rainl ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_snowc ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_snowl ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_swndr ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_swvdr ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_swndf ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_swvdf ) ! from atm - black carbon deposition fluxes (3) ! (1) => bcphidry, (2) => bcphodry, (3) => bcphiwet - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_bcph', ungridded_lbound=1, ungridded_ubound=3) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_bcph, ungridded_lbound=1, ungridded_ubound=3) ! from atm - organic carbon deposition fluxes (3) ! (1) => ocphidry, (2) => ocphodry, (3) => ocphiwet - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_ocph', ungridded_lbound=1, ungridded_ubound=3) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_ocph, ungridded_lbound=1, ungridded_ubound=3) ! from atm - wet dust deposition frluxes (4 sizes) ! (1) => dstwet1, (2) => dstwet2, (3) => dstwet3, (4) => dstwet4 - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstwet', ungridded_lbound=1, ungridded_ubound=4) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_dstwet, ungridded_lbound=1, ungridded_ubound=4) ! from - atm dry dust deposition frluxes (4 sizes) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstdry', ungridded_lbound=1, ungridded_ubound=4) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_dstdry, ungridded_lbound=1, ungridded_ubound=4) ! from atm - nitrogen deposition call shr_ndep_readnl("drv_flds_in", ndep_nflds) if (ndep_nflds > 0) then - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Faxa_ndep', ungridded_lbound=1, ungridded_ubound=ndep_nflds) + call fldlist_add(fldsToLnd_num, fldsToLnd, Faxa_ndep, ungridded_lbound=1, ungridded_ubound=ndep_nflds) ! This sets a variable in clm_varctl ndep_from_cpl = .true. end if ! from atm - co2 exchange scenarios if (flds_co2a .or. flds_co2b .or. flds_co2c) then - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_co2prog') - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sa_co2diag') + call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_co2prog) + call fldlist_add(fldsToLnd_num, fldsToLnd, Sa_co2diag) end if if (rof_prognostic) then ! from river - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Flrr_flood' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Flrr_volr' ) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Flrr_volrmch' ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Flrr_flood ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Flrr_volr ) + call fldlist_add(fldsToLnd_num, fldsToLnd, Flrr_volrmch ) end if if (glc_present) then ! from land-ice (glc) - no elevation classes - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sg_icemask' ) ! mask of where cism is running - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sg_icemask_coupled_fluxes') ! + call fldlist_add(fldsToLnd_num, fldsToLnd, Sg_icemask ) ! mask of where cism is running + call fldlist_add(fldsToLnd_num, fldsToLnd, Sg_icemask_coupled_fluxes) ! ! from land-ice (glc) - fields for all glc->lnd elevation classes (1:glc_nec) plus bare land (index 0) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sg_ice_covered_elev', ungridded_lbound=1, ungridded_ubound=glc_nec+1) - call fldlist_add(fldsToLnd_num, fldsToLnd, 'Sg_topo_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) + call fldlist_add(fldsToLnd_num, fldsToLnd, Sg_ice_covered_elev, ungridded_lbound=1, ungridded_ubound=glc_nec+1) + call fldlist_add(fldsToLnd_num, fldsToLnd, Sg_topo_elev , ungridded_lbound=1, ungridded_ubound=glc_nec+1) !current not used - but could be used in the future - !call fldlist_add(fldsToLnd_num, fldsToLnd, 'Flgg_hflx_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) + !call fldlist_add(fldsToLnd_num, fldsToLnd, Flgg_hflx_elev , ungridded_lbound=1, ungridded_ubound=glc_nec+1) end if ! Now advertise import fields @@ -310,27 +397,22 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r end subroutine advertise_fields !=============================================================================== - - subroutine realize_fields(gcomp, Emesh, flds_scalar_name, flds_scalar_num, rc) + subroutine realize_fields(importState, exportState, Emesh, flds_scalar_name, flds_scalar_num, rc) ! input/output variables - type(ESMF_GridComp) , intent(inout) :: gcomp - type(ESMF_Mesh) , intent(in) :: Emesh - character(len=*) , intent(in) :: flds_scalar_name - integer , intent(in) :: flds_scalar_num - integer , intent(out) :: rc + type(ESMF_State) , intent(inout) :: importState + type(ESMF_State) , intent(inout) :: exportState + type(ESMF_Mesh) , intent(in) :: Emesh + character(len=*) , intent(in) :: flds_scalar_name + integer , intent(in) :: flds_scalar_num + integer , intent(out) :: rc ! local variables - type(ESMF_State) :: importState - type(ESMF_State) :: exportState character(len=*), parameter :: subname='(lnd_import_export:realize_fields)' !--------------------------------------------------------------------------- rc = ESMF_SUCCESS - call NUOPC_ModelGet(gcomp, importState=importState, exportState=exportState, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldlist_realize( & state=ExportState, & fldList=fldsFrLnd, & @@ -354,7 +436,6 @@ subroutine realize_fields(gcomp, Emesh, flds_scalar_name, flds_scalar_num, rc) end subroutine realize_fields !=============================================================================== - subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & atm2lnd_inst, glc2lnd_inst, wateratm2lndbulk_inst, rc) @@ -362,19 +443,20 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & ! Convert the input data from the mediator to the land model !--------------------------------------------------------------------------- - use clm_varctl , only: co2_type, co2_ppmv, use_c13, ndep_from_cpl - use clm_varcon , only: rair, o2_molar_const, c13ratio - use shr_const_mod , only: SHR_CONST_TKFRZ - use Wateratm2lndBulkType , only: wateratm2lndbulk_type - use QSatMod , only: QSat + use clm_varctl , only: co2_type, co2_ppmv, use_c13, ndep_from_cpl + use clm_varcon , only: rair, o2_molar_const, c13ratio + use shr_const_mod , only: SHR_CONST_TKFRZ + use Wateratm2lndBulkType , only: wateratm2lndbulk_type + use QSatMod , only: QSat + use lnd_import_export_utils , only: derive_quantities, check_for_errors ! input/output variabes type(ESMF_GridComp) :: gcomp - type(bounds_type) , intent(in) :: bounds ! bounds + type(bounds_type) , intent(in) :: bounds ! bounds logical , intent(in) :: glc_present ! .true. => running with a non-stub GLC model logical , intent(in) :: rof_prognostic ! .true. => running with a prognostic ROF 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 + type(atm2lnd_type) , intent(inout) :: atm2lnd_inst ! clm internal input data type + type(glc2lnd_type) , intent(inout) :: glc2lnd_inst ! clm internal input data type type(Wateratm2lndbulk_type) , intent(inout) :: wateratm2lndbulk_inst integer , intent(out) :: rc @@ -382,13 +464,16 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & type(ESMF_State) :: importState type(ESMF_StateItem_Flag) :: itemFlag real(r8), pointer :: dataPtr(:) - character(len=128) :: fldname + real(r8), pointer :: fldPtr1d(:) + real(r8), pointer :: fldPtr2d(:,:) + character(len=CS) :: fldname integer :: num - integer :: begg, endg ! bounds - integer :: g,i,k ! indices - real(r8) :: qsat_kg_kg ! saturation specific humidity (kg/kg) - real(r8) :: forc_pbot ! atmospheric pressure (Pa) + integer :: begg, endg ! bounds + integer :: g,i,k,n ! indices + real(r8) :: qsat_kg_kg ! saturation specific humidity (kg/kg) + real(r8) :: forc_pbot ! atmospheric pressure (Pa) real(r8) :: co2_ppmv_input(bounds%begg:bounds%endg) ! temporary + real(r8) :: forc_ndep(bounds%begg:bounds%endg,2) real(r8) :: forc_rainc(bounds%begg:bounds%endg) ! rainxy Atm flux mm/s real(r8) :: forc_rainl(bounds%begg:bounds%endg) ! rainxy Atm flux mm/s real(r8) :: forc_snowc(bounds%begg:bounds%endg) ! snowfxy Atm flux mm/s @@ -401,7 +486,6 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & real(r8) :: icemask_grc(bounds%begg:bounds%endg) real(r8) :: icemask_coupled_fluxes_grc(bounds%begg:bounds%endg) character(len=*), parameter :: subname='(lnd_import_export:import_fields)' - !--------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -420,141 +504,109 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & ! by 1000 mm/m resulting in an overall factor of unity. ! Below the units are therefore given in mm/s. - !-------------------------- - ! Required atmosphere input fields - !-------------------------- - - call state_getimport(importState, 'Sa_z', bounds, output=atm2lnd_inst%forc_hgt_grc, rc=rc) + ! Required atm input fields + call state_getimport_1d(importState, Sa_z , atm2lnd_inst%forc_hgt_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Sa_topo', bounds, output=atm2lnd_inst%forc_topo_grc, rc=rc) + call state_getimport_1d(importState, Sa_topo , atm2lnd_inst%forc_topo_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Sa_u', bounds, output=atm2lnd_inst%forc_u_grc, rc=rc ) + call state_getimport_1d(importState, Sa_u , atm2lnd_inst%forc_u_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Sa_v', bounds, output=atm2lnd_inst%forc_v_grc, rc=rc ) + call state_getimport_1d(importState, Sa_v , atm2lnd_inst%forc_v_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Sa_ptem', bounds, output=atm2lnd_inst%forc_th_not_downscaled_grc, rc=rc) + call state_getimport_1d(importState, Sa_shum , wateratm2lndbulk_inst%forc_q_not_downscaled_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Sa_shum', bounds, output=wateratm2lndbulk_inst%forc_q_not_downscaled_grc, rc=rc) + call state_getimport_1d(importState, Sa_ptem , atm2lnd_inst%forc_th_not_downscaled_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Sa_pbot', bounds, output=atm2lnd_inst%forc_pbot_not_downscaled_grc, rc=rc) + call state_getimport_1d(importState, Sa_pbot , atm2lnd_inst%forc_pbot_not_downscaled_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Sa_tbot', bounds, output=atm2lnd_inst%forc_t_not_downscaled_grc, rc=rc) + call state_getimport_1d(importState, Sa_tbot , atm2lnd_inst%forc_t_not_downscaled_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Faxa_rainc', bounds, output=forc_rainc, rc=rc ) + call state_getimport_1d(importState, Faxa_rainc, forc_rainc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Faxa_rainl', bounds, output=forc_rainl, rc=rc ) + call state_getimport_1d(importState, Faxa_rainl, forc_rainl(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Faxa_snowc', bounds, output=forc_snowc, rc=rc ) + call state_getimport_1d(importState, Faxa_snowc, forc_snowc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Faxa_snowl', bounds, output=forc_snowl, rc=rc ) + call state_getimport_1d(importState, Faxa_snowl, forc_snowl(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Faxa_lwdn', bounds, output=atm2lnd_inst%forc_lwrad_not_downscaled_grc, rc=rc) + call state_getimport_1d(importState, Faxa_lwdn , atm2lnd_inst%forc_lwrad_not_downscaled_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Faxa_swvdr', bounds, output=atm2lnd_inst%forc_solad_grc(:,1), rc=rc) + call state_getimport_1d(importState, Faxa_swvdr, atm2lnd_inst%forc_solad_grc(begg:,1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Faxa_swndr', bounds, output=atm2lnd_inst%forc_solad_grc(:,2), rc=rc) + call state_getimport_1d(importState, Faxa_swndr, atm2lnd_inst%forc_solad_grc(begg:,2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Faxa_swvdf', bounds, output=atm2lnd_inst%forc_solai_grc(:,1), rc=rc ) + call state_getimport_1d(importState, Faxa_swvdf, atm2lnd_inst%forc_solai_grc(begg:,1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Faxa_swndf', bounds, output=atm2lnd_inst%forc_solai_grc(:,2), rc=rc ) + call state_getimport_1d(importState, Faxa_swndf, atm2lnd_inst%forc_solai_grc(begg:,2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Atmosphere prognostic/prescribed aerosol fields - - ! bcphidry - call state_getimport(importState, 'Faxa_bcph', bounds, output=atm2lnd_inst%forc_aer_grc(:,1), & - ungridded_index=1, rc=rc ) + ! optional atm input fields + ! 1 = bcphidry, 2 = bcphodry, 3 = bcphiwet + call state_getimport_2d(importState, Faxa_bcph, atm2lnd_inst%forc_aer_grc(begg:,1:3), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! bcphodry - call state_getimport(importState, 'Faxa_bcph', bounds, output=atm2lnd_inst%forc_aer_grc(:,2), & - ungridded_index=2, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! bcphiwet - call state_getimport(importState, 'Faxa_bcph', bounds, output=atm2lnd_inst%forc_aer_grc(:,3), & - ungridded_index=3, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! ocphidry - call state_getimport(importState, 'Faxa_ocph', bounds, output=atm2lnd_inst%forc_aer_grc(:,4), & - ungridded_index=1, rc=rc ) + ! 4 = ocphidry, 5 = ocphodry, 6 = ocphiwet + call state_getimport_2d(importState, Faxa_ocph, atm2lnd_inst%forc_aer_grc(begg:,4:6), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! ocphodry - call state_getimport(importState, 'Faxa_ocph', bounds, output=atm2lnd_inst%forc_aer_grc(:,5), & - ungridded_index=2, rc=rc ) + ! 7 = dstwet1, 9 = dstwet2, 11 = dstwet3, 13 = dstwet4 + call state_getimport_2d(importState, Faxa_dstwet, atm2lnd_inst%forc_aer_grc(begg:,7:13:2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! ocphiwet - call state_getimport(importState, 'Faxa_ocph', bounds, output=atm2lnd_inst%forc_aer_grc(:,6), & - ungridded_index=3, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,7), & - ungridded_index=1, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,8), & - ungridded_index=1, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,9), & - ungridded_index=2, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,10), & - ungridded_index=2, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,11), & - ungridded_index=3, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,12), & - ungridded_index=3, rc=rc ) + ! 8 = dstdry1, 10 = dstdry2, 12 = dstdry3, 14 = dstdry4 + call state_getimport_2d(importState, Faxa_dstdry, atm2lnd_inst%forc_aer_grc(begg:,8:14:2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (fldchk(importState, Sa_methane)) then + call state_getimport_1d(importState, Sa_methane, atm2lnd_inst%forc_pch4_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - call state_getimport(importState, 'Faxa_dstwet', bounds, output=atm2lnd_inst%forc_aer_grc(:,13), & - ungridded_index=4, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_dstdry', bounds, output=atm2lnd_inst%forc_aer_grc(:,14), & - ungridded_index=4, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Flooding from river + ! 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. + if (fldchk(importState, Flrr_flood)) then + call state_getimport_1d(importState, Flrr_flood, wateratm2lndbulk_inst%forc_flood_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do g = begg, endg + wateratm2lndbulk_inst%forc_flood_grc(g) = -wateratm2lndbulk_inst%forc_flood_grc(g) + end do + else + wateratm2lndbulk_inst%forc_flood_grc(:) = 0._r8 + end if + if (fldchk(importState, Flrr_volr)) then + call state_getimport_1d(importState, Flrr_volr, wateratm2lndbulk_inst%volr_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do g = begg, endg + wateratm2lndbulk_inst%volr_grc(g) = wateratm2lndbulk_inst%volr_grc(g) * (ldomain%area(g) * 1.e6_r8) + end do + else + wateratm2lndbulk_inst%volr_grc(:) = 0._r8 + end if + if (fldchk(importState, Flrr_volrmch)) then + call state_getimport_1d(importState, Flrr_volrmch, wateratm2lndbulk_inst%volrmch_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do g = begg, endg + wateratm2lndbulk_inst%volrmch_grc(g) = wateratm2lndbulk_inst%volrmch_grc(g) * (ldomain%area(g) * 1.e6_r8) + end do + else + wateratm2lndbulk_inst%volrmch_grc(:) = 0._r8 + end if - call state_getimport(importState, 'Sa_methane', bounds, output=atm2lnd_inst%forc_pch4_grc, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !-------------------------- + ! Derived quantities for required fields + ! and corresponding error checks + !-------------------------- - ! The mediator is sending ndep in units if kgN/m2/s - and ctsm uses units of gN/m2/sec - ! so the following conversion needs to happen + call derive_quantities(bounds, atm2lnd_inst, wateratm2lndbulk_inst, & + forc_rainc, forc_rainl, forc_snowc, forc_snowl) - call state_getimport(importState, 'Faxa_ndep', bounds, output=forc_nhx, ungridded_index=1, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Faxa_ndep', bounds, output=forc_noy, ungridded_index=2, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do g = begg,endg - atm2lnd_inst%forc_ndep_grc(g) = (forc_nhx(g) + forc_noy(g))*1000._r8 - end do + call check_for_errors(bounds, atm2lnd_inst, wateratm2lndbulk_inst) - !-------------------------- ! Atmosphere co2 - !-------------------------- - ! Set default value to a constant and overwrite for prognostic and diagnostic do g = begg,endg co2_ppmv_input(g) = co2_ppmv end do if (co2_type == 'prognostic') then - fldName = 'Sa_co2prog' + fldName = Sa_co2prog call ESMF_StateGet(importState, trim(fldname), itemFlag, rc=rc) if ( ChkErr(rc,__LINE__,u_FILE_u)) return if (itemflag == ESMF_STATEITEM_NOTFOUND .and. co2_type == 'prognostic') then @@ -568,7 +620,7 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & end do end if else if (co2_type == 'diagnostic') then - fldName = 'Sa_co2diag' + fldName = Sa_co2diag call ESMF_StateGet(importState, trim(fldname), itemFlag, rc=rc) if ( ChkErr(rc,__LINE__,u_FILE_u)) return if (itemflag == ESMF_STATEITEM_NOTFOUND .and. co2_type == 'diagnostic') then @@ -588,95 +640,67 @@ subroutine import_fields( gcomp, bounds, glc_present, rof_prognostic, & do g = begg,endg forc_pbot = atm2lnd_inst%forc_pbot_not_downscaled_grc(g) atm2lnd_inst%forc_pco2_grc(g) = co2_ppmv_input(g) * 1.e-6_r8 * forc_pbot - if (use_c13) then - atm2lnd_inst%forc_pc13o2_grc(g) = co2_ppmv_input(g) * c13ratio * 1.e-6_r8 * forc_pbot - end if end do - - !-------------------------- - ! Flooding back from river - !-------------------------- - - ! 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. - - if (rof_prognostic) then - call state_getimport(importState, 'Flrr_flood', bounds, output=wateratm2lndbulk_inst%forc_flood_grc, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - wateratm2lndbulk_inst%forc_flood_grc(:) = -wateratm2lndbulk_inst%forc_flood_grc(:) - else - wateratm2lndbulk_inst%forc_flood_grc(:) = 0._r8 - end if - - if (rof_prognostic) then - call state_getimport(importState, 'Flrr_volr', bounds, output=wateratm2lndbulk_inst%volr_grc, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - wateratm2lndbulk_inst%volr_grc(:) = wateratm2lndbulk_inst%volr_grc(:) * (ldomain%area(:) * 1.e6_r8) - else - wateratm2lndbulk_inst%volr_grc(:) = 0._r8 + if (use_c13) then + do g = begg,endg + forc_pbot = atm2lnd_inst%forc_pbot_not_downscaled_grc(g) + atm2lnd_inst%forc_pc13o2_grc(g) = co2_ppmv_input(g) * c13ratio * 1.e-6_r8 * forc_pbot + end do end if - if (rof_prognostic) then - call state_getimport(importState, 'Flrr_volrmch', bounds, output=wateratm2lndbulk_inst%volrmch_grc, rc=rc ) + ! Atmosphere ndep + if (fldchk(importState, Faxa_ndep)) then + ! The mediator is sending ndep in units if kgN/m2/s - and ctsm + ! uses units of gN/m2/sec so the following conversion needs to happen + call state_getimport_2d(importState, Faxa_ndep, forc_ndep(begg:,:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - wateratm2lndbulk_inst%volrmch_grc(:) = wateratm2lndbulk_inst%volrmch_grc(:) * (ldomain%area(:) * 1.e6_r8) - else - wateratm2lndbulk_inst%volrmch_grc(:) = 0._r8 + do g = begg, endg + atm2lnd_inst%forc_ndep_grc(g) = (forc_ndep(g,1) + forc_ndep(g,2))*1000._r8 + end do end if - !-------------------------- ! Land-ice (glc) fields - !-------------------------- - if (glc_present) then ! We could avoid setting these fields if glc_present is .false., if that would ! help with performance. (The downside would be that we wouldn't have these fields ! available for diagnostic purposes or to force a later T compset with dlnd.) - do num = 0,glc_nec - call state_getimport(importState, 'Sg_ice_covered_elev', bounds, frac_grc(:,num), ungridded_index=num+1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Sg_topo_elev' , bounds, topo_grc(:,num), ungridded_index=num+1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Flgg_hflx_elev' , bounds, hflx_grc(:,num), ungridded_index=num+1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - call state_getimport(importState, 'Sg_icemask' , bounds, icemask_grc, rc=rc) + call state_getimport_2d(importState, Sg_ice_covered_elev , frac_grc(begg:,0:glc_nec), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_getimport(importState, 'Sg_icemask_coupled_fluxes', bounds, icemask_coupled_fluxes_grc, rc=rc) + call state_getimport_2d(importState, Sg_topo_elev , topo_grc(begg:,0:glc_nec), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport_1d(importState, Sg_icemask , icemask_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_getimport_1d(importState, Sg_icemask_coupled_fluxes , icemask_coupled_fluxes_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (fldchk(importState, Flgg_hflx_elev)) then + call state_getimport_2d(importState, Flgg_hflx_elev, hflx_grc(begg:,0:glc_nec), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + hflx_grc(:,:) = 0._r8 + end if call glc2lnd_inst%set_glc2lnd_fields_nuopc( bounds, glc_present, & frac_grc, topo_grc, hflx_grc, icemask_grc, icemask_coupled_fluxes_grc ) end if - !-------------------------- - ! Derived quantities for required fields - ! and corresponding error checks - !-------------------------- - - call derive_quantities(bounds, atm2lnd_inst, wateratm2lndbulk_inst, & - forc_rainc, forc_rainl, forc_snowc, forc_snowl) - - call check_for_errors(bounds, atm2lnd_inst, wateratm2lndbulk_inst) - end subroutine import_fields !=============================================================================== - subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & waterlnd2atmbulk_inst, lnd2atm_inst, lnd2glc_inst, rc) !------------------------------- ! Pack the export state + ! sign convention is positive downward with hierarchy of atm/glc/lnd/rof/ice/ocn. + ! i.e. water sent from land to rof is positive !------------------------------- use Waterlnd2atmBulkType , only: waterlnd2atmbulk_type ! input/output variables type(ESMF_GridComp) :: gcomp - type(bounds_type) , intent(in) :: bounds ! bounds + type(bounds_type) , intent(in) :: bounds logical , intent(in) :: glc_present logical , intent(in) :: rof_prognostic type(waterlnd2atmbulk_type) , intent(inout) :: waterlnd2atmbulk_inst @@ -685,9 +709,13 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & integer , intent(out) :: rc ! local variables - type(ESMF_State) :: exportState - integer :: i, g, num - real(r8) :: array(bounds%begg:bounds%endg) + type(ESMF_State) :: exportState + real(r8), pointer :: fldPtr1d(:) + real(r8), pointer :: fldPtr2d(:,:) + character(len=CS) :: fldname + integer :: begg, endg + integer :: i, g, num + real(r8) :: data1d(bounds%begg:bounds%endg) character(len=*), parameter :: subname='(lnd_import_export:export_fields)' !--------------------------------------------------------------------------- @@ -697,178 +725,155 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & call NUOPC_ModelGet(gcomp, exportState=exportState, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Set bounds + begg = bounds%begg + endg = bounds%endg + ! ----------------------- ! output to mediator ! ----------------------- - call state_setexport(exportState, 'Sl_lfrin', bounds, input=ldomain%frac, rc=rc) + call state_setexport_1d(exportState, Sl_lfrin, ldomain%frac(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ----------------------- ! output to atm ! ----------------------- - - call state_setexport(exportState, 'Sl_t', bounds, input=lnd2atm_inst%t_rad_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Sl_snowh', bounds, input=waterlnd2atmbulk_inst%h2osno_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Sl_avsdr', bounds, input=lnd2atm_inst%albd_grc(bounds%begg:,1), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Sl_anidr', bounds, input=lnd2atm_inst%albd_grc(bounds%begg:,2), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Sl_avsdf', bounds, input=lnd2atm_inst%albi_grc(bounds%begg:,1), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Sl_anidf', bounds, input=lnd2atm_inst%albi_grc(bounds%begg:,2), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Sl_tref', bounds, input=lnd2atm_inst%t_ref2m_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Sl_qref', bounds, input=waterlnd2atmbulk_inst%q_ref2m_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Sl_u10', bounds, input=lnd2atm_inst%u_ref10m_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Fall_taux', bounds, input=lnd2atm_inst%taux_grc, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Fall_tauy', bounds, input=lnd2atm_inst%tauy_grc, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Fall_lat', bounds, input=lnd2atm_inst%eflx_lh_tot_grc, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Fall_sen', bounds, input=lnd2atm_inst%eflx_sh_tot_grc, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Fall_lwup', bounds, input=lnd2atm_inst%eflx_lwrad_out_grc, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Fall_evap', bounds, input=waterlnd2atmbulk_inst%qflx_evap_tot_grc, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Fall_swnet', bounds, input=lnd2atm_inst%fsa_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Fall_flxdst', bounds, input=lnd2atm_inst%flxdst_grc(:,1), & - minus=.true., ungridded_index=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_flxdst', bounds, input=lnd2atm_inst%flxdst_grc(:,2), & - minus=.true., ungridded_index=2, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_flxdst', bounds, input=lnd2atm_inst%flxdst_grc(:,3), & - minus=.true., ungridded_index=3, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Fall_flxdst', bounds, input=lnd2atm_inst%flxdst_grc(:,4), & - minus=.true., ungridded_index=4, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Fall_methane', bounds, input=lnd2atm_inst%ch4_surf_flux_tot_grc, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Sl_ram1', bounds, input=lnd2atm_inst%ram1_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Sl_fv', bounds, input=lnd2atm_inst%fv_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, 'Sl_soilw', bounds, & - input=waterlnd2atmbulk_inst%h2osoi_vol_grc(:,1), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! co2 from land - if (flds_co2b .or. flds_co2c) then - call state_setexport(exportState, 'Fall_fco2_lnd', bounds, lnd2atm_inst%net_carbon_exchange_grc, minus=.true., rc=rc) + if (send_to_atm) then + call state_setexport_1d(exportState, Sl_t , lnd2atm_inst%t_rad_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - ! dry dep velocities - do num = 1, drydep_nflds - call state_setexport(exportState, 'Sl_ddvel', bounds, input=lnd2atm_inst%ddvel_grc(:,num), & - ungridded_index=num, rc=rc) + call state_setexport_1d(exportState, Sl_snowh , waterlnd2atmbulk_inst%h2osno_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - - ! MEGAN VOC emis fluxes - do num = 1, shr_megan_mechcomps_n - call state_setexport(exportState, 'Fall_voc', bounds, input=lnd2atm_inst%flxvoc_grc(:,num), minus=.true., & - ungridded_index=num, rc=rc) + call state_setexport_1d(exportState, Sl_avsdr , lnd2atm_inst%albd_grc(begg:,1), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, Sl_anidr , lnd2atm_inst%albd_grc(begg:,2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, Sl_avsdf , lnd2atm_inst%albi_grc(begg:,1), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, Sl_anidf , lnd2atm_inst%albi_grc(begg:,2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, Sl_tref , lnd2atm_inst%t_ref2m_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, Sl_qref , waterlnd2atmbulk_inst%q_ref2m_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, Fall_taux , lnd2atm_inst%taux_grc(begg:), minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, Fall_tauy , lnd2atm_inst%tauy_grc(begg:), minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, Fall_lat , lnd2atm_inst%eflx_lh_tot_grc(begg:), minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, Fall_sen , lnd2atm_inst%eflx_sh_tot_grc(begg:), minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, Fall_lwup , lnd2atm_inst%eflx_lwrad_out_grc(begg:), minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, Fall_evap , waterlnd2atmbulk_inst%qflx_evap_tot_grc(begg:), minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, Fall_swnet, lnd2atm_inst%fsa_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - ! fire emis fluxes - if (emis_nflds > 0) then - do num = 1, emis_nflds - call state_setexport(exportState, 'Fall_fire', bounds, input=lnd2atm_inst%fireflx_grc(:,num), minus=.true., & - ungridded_index=num, rc=rc) + ! optional fields + call state_setexport_2d(exportState, Fall_flxdst, lnd2atm_inst%flxdst_grc(begg:,1:4), & + minus= .true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (fldchk(exportState, Fall_methane)) then + call state_setexport_1d(exportState, Fall_methane, lnd2atm_inst%ch4_surf_flux_tot_grc(begg:), & + minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - call state_setexport(exportState, 'Sl_fztop', bounds, input=lnd2atm_inst%fireztop_grc, rc=rc) + end if + call state_setexport_1d(exportState, Sl_u10, lnd2atm_inst%u_ref10m_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, Sl_ram1, lnd2atm_inst%ram1_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call state_setexport_1d(exportState, Sl_fv, lnd2atm_inst%fv_grc(begg:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (fldchk(exportState, Sl_soilw)) then + call state_setexport_1d(exportState, Sl_soilw, waterlnd2atmbulk_inst%h2osoi_vol_grc(begg:,1), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (fldchk(exportState, Fall_fco2_lnd)) then + call state_setexport_1d(exportState, Fall_fco2_lnd, lnd2atm_inst%net_carbon_exchange_grc(begg:), & + minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (fldchk(exportState, Sl_ddvel)) then ! dry dep velocities + call state_setexport_2d(exportState, Sl_ddvel, lnd2atm_inst%ddvel_grc(begg:,1:drydep_nflds), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (fldchk(exportState, Fall_voc)) then ! megan voc emis fluxes + call state_setexport_2d(exportState, Fall_voc, lnd2atm_inst%flxvoc_grc(begg:,1:shr_megan_mechcomps_n), & + minus = .true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (fldchk(exportState, Fall_fire)) then ! fire emis from land + call state_setexport_2d(exportState, Fall_fire, lnd2atm_inst%fireflx_grc(begg:,1:emis_nflds), & + minus = .true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (fldchk(exportState, Sl_fztop)) then ! fire emis from land + call state_setexport_1d(exportState, Sl_fztop, lnd2atm_inst%fireztop_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if endif - ! sign convention is positive downward with hierarchy of atm/glc/lnd/rof/ice/ocn. - ! i.e. water sent from land to rof is positive ! ----------------------- ! output to river ! ----------------------- - ! surface runoff is the sum of qflx_over, qflx_h2osfc_surf - ! do g = bounds%begg,bounds%endg - ! array(g) = waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(g) + waterlnd2atmbulk_inst%qflx_rofliq_h2osfc_grc(g) - ! end do - call state_setexport(exportState, 'Flrl_rofsur', bounds, input=waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! subsurface runoff is the sum of qflx_drain and qflx_perched_drain - do g = bounds%begg,bounds%endg - array(g) = waterlnd2atmbulk_inst%qflx_rofliq_qsub_grc(g) + waterlnd2atmbulk_inst%qflx_rofliq_drain_perched_grc(g) - end do - call state_setexport(exportState, 'Flrl_rofsub', bounds, input=array, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! qgwl sent individually to coupler - call state_setexport(exportState, 'Flrl_rofgwl', bounds, input=waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! do g = begg,endg + ! data1d(g) = waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(g) + & + ! waterlnd2atmbulk_inst%qflx_rofliq_h2osfc_grc(g) + ! end do - ! ice sent individually to coupler - call state_setexport(exportState, 'Flrl_rofi', bounds, input=waterlnd2atmbulk_inst%qflx_rofice_grc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! irrigation flux to be removed from main channel storage (negative) - call state_setexport(exportState, 'Flrl_irrig', bounds, input=waterlnd2atmbulk_inst%qirrig_grc, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (fldchk(exportState, Flrl_rofsur)) then + call state_setexport_1d(exportState, Flrl_rofsur, waterlnd2atmbulk_inst%qflx_rofliq_qsur_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (fldchk(exportState, Flrl_rofgwl)) then ! qgwl sent individually to mediator + call state_setexport_1d(exportState, Flrl_rofgwl, waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (fldchk(exportState, Flrl_rofi)) then ! ice set individually to mediator + call state_setexport_1d(exportState, Flrl_rofi, waterlnd2atmbulk_inst%qflx_rofice_grc(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (fldchk(exportState, Flrl_irrig)) then ! irrigation flux to be removed from main channel storage (negative) + call state_setexport_1d(exportState, Flrl_irrig, waterlnd2atmbulk_inst%qirrig_grc(begg:), & + minus = .true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (fldchk(exportState, Flrl_rofsub)) then + ! subsurface runoff is the sum of qflx_drain and qflx_perched_drain + do g = begg, endg + data1d(g) = waterlnd2atmbulk_inst%qflx_rofliq_qsub_grc(g) + & + waterlnd2atmbulk_inst%qflx_rofliq_drain_perched_grc(g) + end do + call state_setexport_1d(exportState, Flrl_rofsub, data1d(begg:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if ! ----------------------- ! output to glc ! ----------------------- - ! We could avoid setting these fields if glc_present is .false., if that would ! help with performance. (The downside would be that we wouldn't have these fields ! available for diagnostic purposes or to force a later T compset with dlnd.) - do num = 0,glc_nec - call state_setexport(exportState, 'Sl_tsrf_elev', bounds, input=lnd2glc_inst%tsrf_grc(:,num), & - ungridded_index=num+1, rc=rc) + if (fldchk(exportState, Sl_tsrf_elev)) then + call state_setexport_2d(exportState, Sl_tsrf_elev, lnd2glc_inst%tsrf_grc(begg:,0:glc_nec), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Sl_topo_elev', bounds, input=lnd2glc_inst%topo_grc(:,num), & - ungridded_index=num+1, rc=rc) + end if + if (fldchk(exportState, Sl_topo_elev)) then + call state_setexport_2d(exportState, Sl_topo_elev, lnd2glc_inst%topo_grc(begg:,0:glc_nec), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, 'Flgl_qice_elev', bounds, input=lnd2glc_inst%qice_grc(:,num), & - ungridded_index=num+1, rc=rc) + end if + if (fldchk(exportState, Flgl_qice_elev)) then + call state_setexport_2d(exportState, Flgl_qice_elev, lnd2glc_inst%qice_grc(begg:,0:glc_nec), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do + end if end subroutine export_fields !=============================================================================== - subroutine fldlist_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound) ! input/output variables @@ -901,7 +906,6 @@ subroutine fldlist_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound end subroutine fldlist_add !=============================================================================== - subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scalar_num, mesh, tag, rc) use NUOPC , only : NUOPC_IsConnected, NUOPC_Realize @@ -944,7 +948,7 @@ subroutine fldlist_realize(state, fldList, numflds, flds_scalar_name, flds_scala field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, & ungriddedLbound=(/fldlist(n)%ungridded_lbound/), & ungriddedUbound=(/fldlist(n)%ungridded_ubound/), & - gridToFieldMap=(/gridToFieldMap/), rc=rc) + gridToFieldMap=(/2/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) @@ -1006,185 +1010,168 @@ end subroutine SetScalarField end subroutine fldlist_realize !=============================================================================== + subroutine state_getimport_1d(state, fldname, ctsmdata, rc) - subroutine state_getimport(state, fldname, bounds, output, ungridded_index, rc) + ! fill in ctsm import data for 1d field - ! ---------------------------------------------- - ! Map import state field to output array - ! ---------------------------------------------- + use ESMF, only : ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT, ESMF_LogFoundError + use ESMF, only : ESMF_Finalize - ! input/output variables - type(ESMF_State) , intent(in) :: state - type(bounds_type) , intent(in) :: bounds - character(len=*) , intent(in) :: fldname - real(r8) , intent(out) :: output(bounds%begg:bounds%endg) - integer, optional , intent(in) :: ungridded_index - integer , intent(out) :: rc + ! input/output variabes + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fldname + real(r8) , intent(inout) :: ctsmdata(:) + integer , intent(out) :: rc ! local variables - integer :: g, i,n - real(R8), pointer :: fldptr1d(:) - real(R8), pointer :: fldptr2d(:,:) - type(ESMF_StateItem_Flag) :: itemFlag - character(len=cs) :: cvalue - character(len=*), parameter :: subname='(lnd_import_export:state_getimport)' + real(r8), pointer :: fldPtr1d(:) + integer :: g + character(len=*), parameter :: subname='(lnd_import_export:state_getimport_1d)' ! ---------------------------------------------- rc = ESMF_SUCCESS - ! Determine if field with name fldname exists in state - call ESMF_StateGet(state, trim(fldname), itemFlag, rc=rc) + call state_getfldptr(State, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + do g = 1,size(ctsmdata) + ctsmdata(g) = fldptr1d(g) + end do + call check_for_nans(ctsmdata, trim(fldname), 1) - ! if field exists then create output array - else do nothing - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + end subroutine state_getimport_1d - ! get field pointer - if (present(ungridded_index)) then - write(cvalue,*) ungridded_index - call ESMF_LogWrite(trim(subname)//": getting import for "//trim(fldname)//" index "//trim(cvalue), & - ESMF_LOGMSG_INFO) - call state_getfldptr(state, trim(fldname), fldptr2d=fldptr2d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call ESMF_LogWrite(trim(subname)//": getting import for "//trim(fldname),ESMF_LOGMSG_INFO) - call state_getfldptr(state, trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + !=============================================================================== + subroutine state_getimport_2d(state, fldname, ctsmdata, rc) - ! determine output array - if (present(ungridded_index)) then - if (gridToFieldMap == 1) then - do g = bounds%begg, bounds%endg - n = g - bounds%begg + 1 - output(g) = fldptr2d(n,ungridded_index) - end do - else if (gridToFieldMap == 2) then - do g = bounds%begg, bounds%endg - n = g - bounds%begg + 1 - output(g) = fldptr2d(ungridded_index,n) - end do - end if - else - do g = bounds%begg, bounds%endg - n = g - bounds%begg + 1 - output(g) = fldptr1d(n) - end do - end if + ! fill in ctsm import data for 2d field - ! write debug output if appropriate - if (masterproc .and. debug > 0 .and. get_nstep() < 48) then - do g = bounds%begg,bounds%endg - i = 1 + g - bounds%begg - write(iulog,F01)'import: nstep, n, '//trim(fldname)//' = ',get_nstep(),i,output(g) - end do - end if + use ESMF, only : ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT, ESMF_LogFoundError + use ESMF, only : ESMF_Finalize - ! check for nans - call check_for_nans(output, trim(fldname), bounds%begg) - end if + ! input/output variabes + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fldname + real(r8) , intent(inout) :: ctsmdata(:,:) + integer , intent(out) :: rc - end subroutine state_getimport + ! local variables + real(r8), pointer :: fldPtr2d(:,:) + integer :: g,n + character(len=CS) :: cnum + character(len=*), parameter :: subname='(lnd_import_export:state_getimport_1d)' + ! ---------------------------------------------- - !=============================================================================== + rc = ESMF_SUCCESS - subroutine state_setexport(state, fldname, bounds, input, minus, ungridded_index, rc) + call state_getfldptr(state, trim(fldname), fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(ctsmdata, dim=2) + write(cnum,'(i0)') n + do g = 1,size(ctsmdata,dim=1) + ctsmdata(g,n) = fldptr2d(n,g) + end do + call check_for_nans(ctsmdata(:,n), trim(fldname)//trim(cnum), 1) + end do - ! ---------------------------------------------- - ! Map input array to export state field - ! ---------------------------------------------- + end subroutine state_getimport_2d - use shr_const_mod, only : fillvalue=>SHR_CONST_SPVAL + !=============================================================================== + subroutine state_setexport_1d(state, fldname, ctsmdata, minus, rc) - ! input/output variables - type(ESMF_State) , intent(inout) :: state - type(bounds_type) , intent(in) :: bounds - character(len=*) , intent(in) :: fldname - real(r8) , intent(in) :: input(bounds%begg:bounds%endg) - logical, optional , intent(in) :: minus - integer, optional , intent(in) :: ungridded_index - integer , intent(out) :: rc + ! fill in ctsm export data for 1d field + + use ESMF, only : ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT, ESMF_LogFoundError + use ESMF, only : ESMF_Finalize + + ! input/output variabes + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fldname + real(r8) , intent(in) :: ctsmdata(:) + logical, optional, intent(in) :: minus + integer , intent(out):: rc ! local variables - logical :: l_minus ! local version of minus - integer :: g, i, n - real(R8), pointer :: fldptr1d(:) - real(R8), pointer :: fldptr2d(:,:) - character(len=cs) :: cvalue - type(ESMF_StateItem_Flag) :: itemFlag - character(len=*), parameter :: subname='(lnd_import_export:state_setexport)' + logical :: l_minus ! local version of minus + real(r8), pointer :: fldPtr1d(:) + integer :: g + character(len=*), parameter :: subname='(lnd_export_export:state_setexport_1d)' ! ---------------------------------------------- rc = ESMF_SUCCESS - l_minus = .false. if (present(minus)) then l_minus = minus + else + l_minus = .false. end if - ! Determine if field with name fldname exists in state - call ESMF_StateGet(state, trim(fldname), itemFlag, rc=rc) + call state_getfldptr(state, trim(fldname), fldptr1d=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr1d(:) = 0._r8 + if (l_minus) then + do g = 1,size(ctsmdata) + fldptr1d(g) = -ctsmdata(g) + end do + else + do g = 1,size(ctsmdata) + fldptr1d(g) = ctsmdata(g) + end do + end if + call check_for_nans(ctsmdata, trim(fldname), 1) - ! if field exists then create output array - else do nothing - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + end subroutine state_setexport_1d - ! get field pointer - if (present(ungridded_index)) then - write(cvalue,*) ungridded_index - call ESMF_LogWrite(trim(subname)//": setting export for "//trim(fldname)//" index "//trim(cvalue), & - ESMF_LOGMSG_INFO) - call state_getfldptr(state, trim(fldname), fldptr2d=fldptr2d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call ESMF_LogWrite(trim(subname)//": setting export for "//trim(fldname), ESMF_LOGMSG_INFO) - call state_getfldptr(state, trim(fldname), fldptr1d=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + !=============================================================================== + subroutine state_setexport_2d(state, fldname, ctsmdata, minus, rc) + + ! fill in ctsm export data for 2d field + + use ESMF, only : ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT, ESMF_LogFoundError + use ESMF, only : ESMF_Finalize - ! TODO: if fillvalue = shr_const_spval the snowhl sent to the atm will have the spval over some points - ! rather than 0 - this is very odd and needs to be understood - !fldptr1d(:) = fillvalue - - ! determine output array - if (present(ungridded_index)) then - fldptr2d(ungridded_index,:) = 0._r8 - !fldptr2d(ungridded_index,:) = fillvalue - do g = bounds%begg, bounds%endg - n = g - bounds%begg + 1 - fldptr2d(ungridded_index,n) = input(g) + ! input/output variabes + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fldname + real(r8) , intent(in) :: ctsmdata(:,:) + logical, optional, intent(in) :: minus + integer , intent(out):: rc + + ! local variables + logical :: l_minus ! local version of minus + real(r8), pointer :: fldPtr2d(:,:) + integer :: g, n + character(len=CS) :: cnum + character(len=*), parameter :: subname='(lnd_export_export:state_setexport_2d)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + if (present(minus)) then + l_minus = minus + else + l_minus = .false. + end if + + call state_getfldptr(state, trim(fldname), fldptr2d=fldptr2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + fldptr2d(:,:) = 0._r8 + do n = 1,size(ctsmdata, dim=2) + write(cnum,'(i0)') n + if (l_minus) then + do g = 1,size(ctsmdata, dim=1) + fldptr2d(n,g) = -ctsmdata(g,n) end do - if (l_minus) then - fldptr2d(ungridded_index,:) = -fldptr2d(ungridded_index,:) - end if else - fldptr1d(:) = 0._r8 - !fldptr1d(:) = fillvalue - do g = bounds%begg, bounds%endg - n = g - bounds%begg + 1 - fldptr1d(n) = input(g) - end do - if (l_minus) then - fldptr1d(:) = -fldptr1d(:) - end if - end if - - ! write debug output if appropriate - if (masterproc .and. debug > 0 .and. get_nstep() < 48) then - do g = bounds%begg,bounds%endg - i = 1 + g - bounds%begg - write(iulog,F01)'export: nstep, n, '//trim(fldname)//' = ',get_nstep(),i,input(g) + do g = 1,size(ctsmdata, dim=1) + fldptr2d(n,g) = ctsmdata(g,n) end do end if + call check_for_nans(ctsmdata(:,n), trim(fldname)//trim(cnum), 1) + end do - ! check for nans - call check_for_nans(input, trim(fldname), bounds%begg) - end if - - end subroutine state_setexport + end subroutine state_setexport_2d !=============================================================================== - subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) ! ---------------------------------------------- @@ -1205,8 +1192,6 @@ subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) ! local variables type(ESMF_FieldStatus_Flag) :: status type(ESMF_Field) :: lfield - type(ESMF_Mesh) :: lmesh - integer :: nnodes, nelements character(len=*), parameter :: subname='(lnd_import_export:state_getfldptr)' ! ---------------------------------------------- @@ -1214,38 +1199,37 @@ subroutine state_getfldptr(State, fldname, fldptr1d, fldptr2d, rc) call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_FieldGet(lfield, status=status, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (status /= ESMF_FIELDSTATUS_COMPLETE) then - call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - else - call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) + if (present(fldptr1d)) then + call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + else if (present(fldptr2d)) then + call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort("either fldptr1d or fldptr2d must be an input argument") + end if - if (nnodes == 0 .and. nelements == 0) then - call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if + end subroutine state_getfldptr - if (present(fldptr1d)) then - call ESMF_FieldGet(lfield, farrayPtr=fldptr1d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (present(fldptr2d)) then - call ESMF_FieldGet(lfield, farrayPtr=fldptr2d, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call shr_sys_abort("either fldptr1d or fldptr2d must be an input argument") - end if - endif ! status + !=============================================================================== + logical function fldchk(state, fldname) + ! ---------------------------------------------- + ! Determine if field with fldname is in the input state + ! ---------------------------------------------- - end subroutine state_getfldptr + ! input/output variables + type(ESMF_State), intent(in) :: state + character(len=*), intent(in) :: fldname + + ! local variables + type(ESMF_StateItem_Flag) :: itemFlag + ! ---------------------------------------------- + call ESMF_StateGet(state, trim(fldname), itemFlag) + if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + fldchk = .true. + else + fldchk = .false. + endif + end function fldchk end module lnd_import_export diff --git a/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 new file mode 100644 index 0000000000..55ab210e18 --- /dev/null +++ b/src/cpl/share_esmf/lnd_set_decomp_and_domain.F90 @@ -0,0 +1,811 @@ +module lnd_set_decomp_and_domain + + use ESMF + use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl + use shr_sys_mod , only : shr_sys_abort + use spmdMod , only : masterproc + use clm_varctl , only : iulog + + implicit none + private ! except + + ! Module public routines + public :: lnd_set_decomp_and_domain_from_readmesh + public :: lnd_set_mesh_for_single_column + public :: lnd_set_decomp_and_domain_for_single_column + + ! Module private routines + private :: lnd_get_global_dims + private :: lnd_set_lndmask_from_maskmesh + private :: lnd_set_lndmask_from_lndmesh + private :: lnd_set_lndmask_from_fatmlndfrc + private :: lnd_set_ldomain_gridinfo_from_mesh + private :: chkerr + private :: pio_check_err + + character(len=*) , parameter :: u_FILE_u = & + __FILE__ + character(len=*), parameter, private :: sourcefile = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine lnd_set_decomp_and_domain_from_readmesh(driver, vm, meshfile_lnd, meshfile_mask, mesh_ctsm, & + ni, nj, rc) + + use decompInitMod , only : decompInit_ocn, decompInit_lnd, decompInit_lnd3D + use domainMod , only : ldomain, domain_init + use decompMod , only : ldecomp, bounds_type, get_proc_bounds + use clm_varpar , only : nlevsoi + use clm_varctl , only : use_soil_moisture_streams + + ! input/output variables + character(len=*) , intent(in) :: driver ! cmeps or lilac + type(ESMF_VM) , intent(in) :: vm + character(len=*) , intent(in) :: meshfile_lnd + character(len=*) , intent(in) :: meshfile_mask + type(ESMF_Mesh) , intent(out) :: mesh_ctsm + integer , intent(out) :: ni,nj ! global grid dimensions + integer , intent(out) :: rc + + ! local variables + type(ESMF_Mesh) :: mesh_maskinput + type(ESMF_Mesh) :: mesh_lndinput + type(ESMF_DistGrid) :: distgrid_ctsm + integer :: g,n ! indices + integer :: nlnd, nocn ! local size of arrays + integer :: gsize ! global size of grid + logical :: isgrid2d ! true => grid is 2d + type(bounds_type) :: bounds ! bounds + integer :: begg,endg ! local bounds + integer , pointer :: gindex_lnd(:) ! global index space for just land points + integer , pointer :: gindex_ocn(:) ! global index space for just ocean points + integer , pointer :: gindex_ctsm(:) ! global index space for land and ocean points + integer , pointer :: lndmask_glob(:) + real(r8) , pointer :: lndfrac_glob(:) + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Write diag info + if (masterproc) then + write(iulog,*) + write(iulog,'(a)')' Input land mesh file '//trim(meshfile_lnd) + write(iulog,'(a)')' Input mask mesh file '//trim(meshfile_mask) + if (trim(meshfile_mask) /= trim(meshfile_lnd)) then + write(iulog, '(a)') ' Obtaining land mask and fraction from mask file '//trim(meshfile_mask) + else + write(iulog, '(a)') ' Obtaining land mask and fraction from land mesh file '//trim(meshfile_lnd) + end if + write(iulog,*) + end if + + ! Determine global 2d sizes from read of dimensions of surface dataset and allocate global memory + call lnd_get_global_dims(ni, nj, gsize, isgrid2d) + allocate(lndmask_glob(gsize)); lndmask_glob(:) = 0 + allocate(lndfrac_glob(gsize)); lndfrac_glob(:) = 0._r8 + + ! Read in the land mesh from the file + mesh_lndinput = ESMF_MeshCreate(filename=trim(meshfile_lnd), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (trim(driver) == 'cmeps') then + ! Read in mask meshfile if needed + if (trim(meshfile_mask) /= trim(meshfile_lnd)) then + mesh_maskinput = ESMF_MeshCreate(filename=trim(meshfile_mask), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Determine lndmask_glob and lndfrac_glob + if (trim(meshfile_mask) /= trim(meshfile_lnd)) then + ! obain land mask and land fraction by mapping ocean mesh conservatively to land mesh + call lnd_set_lndmask_from_maskmesh(mesh_lndinput, mesh_maskinput, vm, gsize, lndmask_glob, lndfrac_glob, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + ! obtain land mask from land mesh file - assume that land frac is identical to land mask + call lnd_set_lndmask_from_lndmesh(mesh_lndinput, vm, gsize, lndmask_glob, lndfrac_glob, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + else if (trim(driver) == 'lilac') then + call lnd_set_lndmask_from_fatmlndfrc(lndmask_glob, lndfrac_glob, ni,nj) + else + call shr_sys_abort('driver '//trim(driver)//' is not supported, must be lilac or cmeps') + end if + + ! Determine lnd decomposition that will be used by ctsm from lndmask_glob + call decompInit_lnd(lni=ni, lnj=nj, amask=lndmask_glob) + if (use_soil_moisture_streams) then + call decompInit_lnd3D(lni=ni, lnj=nj, lnk=nlevsoi) + end if + + ! Determine ocn decomposition that will be used to create the full mesh + ! note that the memory for gindex_ocn will be allocated in the following call + ! but deallocated at the end of this routine + call decompInit_ocn(ni=ni, nj=nj, amask=lndmask_glob, gindex_ocn=gindex_ocn) + + ! Get JUST gridcell processor bounds + ! Remaining bounds (landunits, columns, patches) will be set after calling decompInit_glcp + ! so get_proc_bounds is called twice and the gridcell information is just filled in twice + call get_proc_bounds(bounds) + begg = bounds%begg + endg = bounds%endg + + ! Create ctsm gindex_lnd + nlnd = endg - begg + 1 + allocate(gindex_lnd(nlnd)) + do g = begg, endg + n = 1 + (g - begg) + gindex_lnd(n) = ldecomp%gdc2glo(g) + end do + + ! Initialize domain data structure + call domain_init(domain=ldomain, isgrid2d=isgrid2d, ni=ni, nj=nj, nbeg=begg, nend=endg) + + ! Determine ldomain%mask and ldomain%frac using ctsm decomposition + do g = begg, endg + n = 1 + (g - begg) + ldomain%mask(g) = lndmask_glob(gindex_lnd(n)) + ldomain%frac(g) = lndfrac_glob(gindex_lnd(n)) + end do + + ! Deallocate global pointer memory + deallocate(lndmask_glob) + deallocate(lndfrac_glob) + + ! Generate a ctsm global index that includes both land and ocean points + nocn = size(gindex_ocn) + allocate(gindex_ctsm(nlnd + nocn)) + do n = 1,nlnd+nocn + if (n <= nlnd) then + gindex_ctsm(n) = gindex_lnd(n) + else + gindex_ctsm(n) = gindex_ocn(n-nlnd) + end if + end do + + ! Generate a new mesh on the gindex decomposition + distGrid_ctsm = ESMF_DistGridCreate(arbSeqIndexList=gindex_ctsm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + mesh_ctsm = ESMF_MeshCreate(mesh_lndinput, elementDistGrid=distgrid_ctsm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Set ldomain%lonc, ldomain%latc and ldomain%area + call lnd_set_ldomain_gridinfo_from_mesh(mesh_ctsm, vm, gindex_ctsm, begg, endg, isgrid2d, ni, nj, ldomain, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Deallocate local pointer memory + deallocate(gindex_lnd) + deallocate(gindex_ocn) + deallocate(gindex_ctsm) + + end subroutine lnd_set_decomp_and_domain_from_readmesh + + !=============================================================================== + subroutine lnd_set_mesh_for_single_column(scol_lon, scol_lat, mesh, rc) + + ! Generate a mesh for single column + use netcdf + use clm_varcon, only : spval + + ! input/output variables + real(r8) , intent(in) :: scol_lon + real(r8) , intent(in) :: scol_lat + type(ESMF_Mesh) , intent(out) :: mesh + integer , intent(out) :: rc + + ! local variables + type(ESMF_Grid) :: lgrid + integer :: maxIndex(2) + real(r8) :: mincornerCoord(2) + real(r8) :: maxcornerCoord(2) + character(len=*), parameter :: subname= ' (lnd_set_mesh_for_single_column) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Use center and come up with arbitrary area delta lon and lat = .1 degree + maxIndex(1) = 1 ! number of lons + maxIndex(2) = 1 ! number of lats + mincornerCoord(1) = scol_lon - .1_r8 ! min lon + mincornerCoord(2) = scol_lat - .1_r8 ! min lat + maxcornerCoord(1) = scol_lon + .1_r8 ! max lon + maxcornerCoord(2) = scol_lat + .1_r8 ! max lat + ! create the ESMF grid + lgrid = ESMF_GridCreateNoPeriDimUfrm (maxindex=maxindex, & + mincornercoord=mincornercoord, maxcornercoord= maxcornercoord, & + staggerloclist=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create the mesh from the lgrid + mesh = ESMF_MeshCreate(lgrid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine lnd_set_mesh_for_single_column + + !=============================================================================== + subroutine lnd_set_decomp_and_domain_for_single_column(scol_lon, scol_lat, scol_mask, scol_frac) + + use decompInitMod , only : decompInit_lnd, decompInit_lnd3D + use decompMod , only : bounds_type, get_proc_bounds + use domainMod , only : ldomain, domain_init + use clm_varctl , only : use_soil_moisture_streams + use clm_varpar , only : nlevsoi + use clm_varcon , only : spval + + ! input/output variables + real(r8) , intent(in) :: scol_lon + real(r8) , intent(in) :: scol_lat + integer , intent(in) :: scol_mask + real(r8) , intent(in) :: scol_frac + + ! local variables + type(bounds_type) :: bounds ! bounds + !------------------------------------------------------------------------------- + + ! Determine ldecomp and ldomain + call decompInit_lnd(lni=1, lnj=1, amask=(/1/)) + if (use_soil_moisture_streams) then + call decompInit_lnd3D(lni=1, lnj=1, lnk=nlevsoi) + end if + + ! Initialize processor bounds + call get_proc_bounds(bounds) + + ! Initialize domain data structure + call domain_init(domain=ldomain, isgrid2d=.false., ni=1, nj=1, nbeg=1, nend=1) + + ! Initialize ldomain attributes + ldomain%lonc(1) = scol_lon + ldomain%latc(1) = scol_lat + ldomain%area(1) = spval + ldomain%mask(1) = scol_mask + ldomain%frac(1) = scol_frac + + end subroutine lnd_set_decomp_and_domain_for_single_column + + !=============================================================================== + subroutine lnd_get_global_dims(ni, nj, gsize, isgrid2d) + + ! Determine global 2d sizes from read of dimensions of surface dataset + ! + ! Meshes do not indicate if the mesh can be represented as a logically rectangular + ! grid. However, CTSM needs this information in the history file generation via the + ! logical variable isgrid2d. Since for CMEPS and LILAC there is no longer the need for + ! the fatmlndfrc file (where the isgrid2d variable was determined from before), the + ! surface dataset is now used to determine if the underlying grid is 2d or not. + + use clm_varctl , only : fsurdat, single_column + use fileutils , only : getfil + use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile, ncd_inqdlen, ncd_inqdid + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_sys_mod , only : shr_sys_abort + + ! input/output variables + integer, intent(out) :: ni + integer, intent(out) :: nj + integer, intent(out) :: gsize + logical, intent(out) :: isgrid2d + + ! local variables + character(len=CL) :: locfn + type(file_desc_t) :: ncid ! netcdf file id + integer :: dimid ! netCDF dimension id + logical :: readvar ! read variable in or not + logical :: dim_exists + logical :: dim_found = .false. + !------------------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'Attempting to global dimensions from surface dataset' + if (fsurdat == ' ') then + write(iulog,*)'fsurdat must be specified' + call endrun(msg=errMsg(sourcefile, __LINE__)) + endif + endif + call getfil(fsurdat, locfn, 0 ) + call ncd_pio_openfile (ncid, trim(locfn), 0) + dim_found = .false. + call ncd_inqdid(ncid, 'lsmlon', dimid, dim_exists) + if ( dim_exists ) then + dim_found = .true. + call ncd_inqdlen(ncid, dimid, ni, 'lsmlon') + call ncd_inqdlen(ncid, dimid, nj, 'lsmlat') + end if + if (.not. dim_found) then + call ncd_inqdid(ncid, 'gridcell', dimid, dim_exists) + if ( dim_exists ) then + dim_found = .true. + call ncd_inqdlen(ncid, dimid, ni, 'gridcell') + nj = 1 + end if + end if + if (.not. dim_found) then + call shr_sys_abort('ERROR: surface dataset does not contain dims of lsmlon,lsmlat or gridcell') + end if + call ncd_pio_closefile(ncid) + gsize = ni*nj + if (single_column) then + isgrid2d = .true. + else if (nj == 1) then + isgrid2d = .false. + else + isgrid2d = .true. + end if + if (masterproc) then + write(iulog,'(a,2(i8,2x))') 'global ni,nj = ',ni,nj + if (isgrid2d) then + write(iulog,'(a)') 'model grid is 2-dimensional' + else + write(iulog,'(a)') 'model grid is not 2-dimensional' + end if + end if + + end subroutine lnd_get_global_dims + + !=============================================================================== + subroutine lnd_set_lndmask_from_maskmesh(mesh_lnd, mesh_mask, vm, gsize, lndmask_glob, lndfrac_glob, rc) + + ! input/out variables + type(ESMF_Mesh) , intent(in) :: mesh_lnd + type(ESMF_Mesh) , intent(in) :: mesh_mask + type(ESMF_VM) , intent(in) :: vm + integer , intent(in) :: gsize + integer , pointer :: lndmask_glob(:) + real(r8) , pointer :: lndfrac_glob(:) + integer , intent(out) :: rc + + ! local variables: + type(ESMF_DistGrid) :: distgrid_lnd + type(ESMF_RouteHandle) :: rhandle_mask2lnd + type(ESMF_Field) :: field_lnd + type(ESMF_Field) :: field_mask + type(ESMF_DistGrid) :: distgrid_mask + integer , pointer :: gindex_input(:) ! global index space for land and ocean points + integer , pointer :: lndmask_loc(:) + integer , pointer :: itemp_glob(:) + real(r8) , pointer :: rtemp_glob(:) + real(r8) , pointer :: lndfrac_loc(:) + real(r8) , pointer :: maskmask_loc(:) ! on ocean mesh + real(r8) , pointer :: maskfrac_loc(:) ! on land mesh + real(r8) , pointer :: dataptr1d(:) + type(ESMF_Array) :: elemMaskArray + integer :: lsize_lnd + integer :: lsize_mask + integer :: n, spatialDim + integer :: srcMaskValue = 0 + integer :: dstMaskValue = -987987 ! spval for RH mask values + integer :: srcTermProcessing_Value = 0 + real(r8) :: fminval = 0.001_r8 + real(r8) :: fmaxval = 1._r8 + logical :: checkflag = .false. + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_MeshGet(mesh_lnd, spatialDim=spatialDim, numOwnedElements=lsize_lnd, & + elementDistGrid=distgrid_lnd, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(lndmask_loc(lsize_lnd)) + allocate(lndfrac_loc(lsize_lnd)) + + ! create fields on land and ocean meshes + field_lnd = ESMF_FieldCreate(mesh_lnd, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + field_mask = ESMF_FieldCreate(mesh_mask, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create route handle to map ocean mask from mask mesh to land mesh + call ESMF_FieldRegridStore(field_mask, field_lnd, routehandle=rhandle_mask2lnd, & + srcMaskValues=(/srcMaskValue/), dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE, normType=ESMF_NORMTYPE_DSTAREA, & + srcTermProcessing=srcTermProcessing_Value, & + ignoreDegenerate=.true., unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! fill in values for field_mask with mask on mask mesh + call ESMF_MeshGet(mesh_mask, elementdistGrid=distgrid_mask, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_DistGridGet(distgrid_mask, localDe=0, elementCount=lsize_mask, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(maskmask_loc(lsize_mask)) + elemMaskArray = ESMF_ArrayCreate(distgrid_mask, maskmask_loc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(mesh_mask, elemMaskArray=elemMaskArray, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field_mask, farrayptr=dataptr1d, rc=rc) + dataptr1d(:) = maskmask_loc(:) + + ! map mask mask to land mesh + call ESMF_FieldRegrid(field_mask, field_lnd, routehandle=rhandle_mask2lnd, & + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(mesh_lnd, spatialDim=spatialDim, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(maskfrac_loc(lsize_lnd)) + call ESMF_FieldGet(field_lnd, farrayptr=maskfrac_loc, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,lsize_lnd + lndfrac_loc(n) = 1._r8 - maskfrac_loc(n) + if (lndfrac_loc(n) > fmaxval) lndfrac_loc(n) = 1._r8 + if (lndfrac_loc(n) < fminval) lndfrac_loc(n) = 0._r8 + if (lndfrac_loc(n) /= 0._r8) then + lndmask_loc(n) = 1 + else + lndmask_loc(n) = 0 + end if + enddo + call ESMF_FieldDestroy(field_lnd) + call ESMF_FieldDestroy(field_mask) + + ! determine global landmask_glob - needed to determine the ctsm decomposition + ! land frac, lats, lons and areas will be done below + allocate(gindex_input(lsize_lnd)) + call ESMF_DistGridGet(distgrid_lnd, 0, seqIndexList=gindex_input, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,lsize_lnd + lndmask_glob(gindex_input(n)) = lndmask_loc(n) + end do + allocate(itemp_glob(gsize)) + call ESMF_VMAllReduce(vm, sendData=lndmask_glob, recvData=itemp_glob, count=gsize, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + lndmask_glob(:) = int(itemp_glob(:)) + deallocate(itemp_glob) + + ! Determine ldomain%frac using both input and ctsm decompositions + ! lndfrac_glob is filled using the input decomposition and + ! ldomin%frac is set using the ctsm decomposition + allocate(rtemp_glob(gsize)) + do n = 1,lsize_lnd + lndfrac_glob(gindex_input(n)) = lndfrac_loc(n) + end do + call ESMF_VMAllReduce(vm, sendData=lndfrac_glob, recvData=rtemp_glob, count=gsize, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + lndfrac_glob(:) = rtemp_glob(:) + deallocate(rtemp_glob) + + ! deallocate memory + deallocate(maskmask_loc) + deallocate(lndmask_loc) + deallocate(lndfrac_loc) + + end subroutine lnd_set_lndmask_from_maskmesh + + !=============================================================================== + subroutine lnd_set_lndmask_from_lndmesh(mesh_lnd, vm, gsize, lndmask_glob, lndfrac_glob, rc) + + ! input/out variables + type(ESMF_Mesh) , intent(in) :: mesh_lnd + type(ESMF_VM) , intent(in) :: vm + integer , intent(in) :: gsize + integer , pointer :: lndmask_glob(:) + real(r8) , pointer :: lndfrac_glob(:) + integer , intent(out) :: rc + + ! local variables: + integer :: n + integer :: lsize + integer , pointer :: gindex(:) + integer , pointer :: lndmask_loc(:) + integer , pointer :: itemp_glob(:) + type(ESMF_DistGrid) :: distgrid + type(ESMF_Array) :: elemMaskArray + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Determine lsize and distgrid_lnd + call ESMF_MeshGet(mesh_lnd, elementdistGrid=distgrid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_DistGridGet(distgrid, localDe=0, elementCount=lsize, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine lndmask_loc + ! The call to ESMF_MeshGet fills in the values of lndmask_loc + allocate(lndmask_loc(lsize)) + elemMaskArray = ESMF_ArrayCreate(distgrid, lndmask_loc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(mesh_lnd, elemMaskArray=elemMaskArray, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine global landmask_glob - needed to determine the ctsm decomposition + ! land frac, lats, lons and areas will be done below + allocate(gindex(lsize)) + allocate(itemp_glob(gsize)) + call ESMF_DistGridGet(distgrid, 0, seqIndexList=gindex, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,lsize + lndmask_glob(gindex(n)) = lndmask_loc(n) + end do + call ESMF_VMAllReduce(vm, sendData=lndmask_glob, recvData=itemp_glob, count=gsize, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + lndmask_glob(:) = int(itemp_glob(:)) + deallocate(itemp_glob) + deallocate(gindex) + deallocate(lndmask_loc) + + ! ASSUME that land fraction is identical to land mask in this case + lndfrac_glob(:) = lndmask_glob(:) + + end subroutine lnd_set_lndmask_from_lndmesh + + !=============================================================================== + subroutine lnd_set_lndmask_from_fatmlndfrc(mask, frac, ni, nj) + + ! Read the surface dataset grid related information + ! This is used to set the domain decomposition - so global data is read here + + use clm_varctl , only : fatmlndfrc + use fileutils , only : getfil + use ncdio_pio , only : ncd_io, ncd_pio_openfile, ncd_pio_closefile, ncd_inqfdims, file_desc_t + use abortutils , only : endrun + use shr_log_mod, only : errMsg => shr_log_errMsg + + ! input/output variables + integer , pointer :: mask(:) ! grid mask + real(r8) , pointer :: frac(:) ! grid fraction + 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 + character(len=256) :: varname ! variable name + character(len=256) :: locfn ! local file name + logical :: readvar ! read variable in or not + integer , allocatable :: idata2d(:,:) + real(r8), allocatable :: rdata2d(:,:) + integer :: unitn + character(len=32) :: subname = 'lnd_set_mask_from_fatmlndfrc' ! subroutine name + !----------------------------------------------------------------------- + + ! Open file + call getfil( fatmlndfrc, 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 + + if (isgrid2d) then + ! Grid is 2d + allocate(idata2d(ni,nj)) + idata2d(:,:) = 1 + call ncd_io(ncid=ncid, varname='mask', data=idata2d, flag='read', readvar=readvar) + if (readvar) then + do j = 1,nj + do i = 1,ni + n = (j-1)*ni + i + mask(n) = idata2d(i,j) + enddo + enddo + else + call endrun( msg=' ERROR: mask not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) + end if + deallocate(idata2d) + allocate(rdata2d(ni,nj)) + rdata2d(:,:) = 1._r8 + call ncd_io(ncid=ncid, varname='frac', data=rdata2d, flag='read', readvar=readvar) + if (readvar) then + do j = 1,nj + do i = 1,ni + n = (j-1)*ni + i + frac(n) = rdata2d(i,j) + enddo + enddo + else + call endrun( msg=' ERROR: mask not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) + end if + deallocate(rdata2d) + else + ! Grid is not 2d + call ncd_io(ncid=ncid, varname='mask', data=mask, flag='read', readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: mask not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) + end if + call ncd_io(ncid=ncid, varname='frac', data=frac, flag='read', readvar=readvar) + if (.not. readvar) then + call endrun( msg=' ERROR: frac not on fatmlndfrc file'//errMsg(sourcefile, __LINE__)) + end if + end if + + ! Close file + call ncd_pio_closefile(ncid) + + end subroutine lnd_set_lndmask_from_fatmlndfrc + + !=============================================================================== + subroutine lnd_set_ldomain_gridinfo_from_mesh(mesh, vm, gindex, begg, endg, isgrid2d, ni, nj, ldomain, rc) + + use domainMod , only : domain_type, lon1d, lat1d + use clm_varcon , only : re + + use clm_varcon , only : grlnd + use fileutils , only : getfil + use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile + + ! input/output variables + type(ESMF_Mesh) , intent(in) :: mesh + type(ESMF_VM) , intent(in) :: vm + integer , intent(in) :: gindex(:) + integer , intent(in) :: begg,endg + logical , intent(in) :: isgrid2d + integer , intent(in) :: ni, nj + type(domain_type) , intent(inout) :: ldomain + integer , intent(out) :: rc + + ! local variables + integer :: g,n + integer :: gsize + integer :: numownedelements + real(r8) , pointer :: ownedElemCoords(:) + integer :: spatialDim + real(r8) , pointer :: dataptr1d(:) + real(r8) , pointer :: lndlats_glob(:) + real(r8) , pointer :: lndlons_glob(:) + real(r8) , pointer :: rtemp_glob(:) + type(ESMF_Field) :: areaField + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Determine ldoman%latc and ldomain%lonc + call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(ownedElemCoords(spatialDim*numownedelements)) + call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do g = begg,endg + n = g - begg + 1 + ldomain%lonc(g) = ownedElemCoords(2*n-1) + if (ldomain%lonc(g) == 360._r8) ldomain%lonc(g) = 0._r8 ! TODO: why the difference? + ldomain%latc(g) = ownedElemCoords(2*n) + end do + + ! Create ldomain%area by querying the mesh on the ctsm decomposition + areaField = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegridGetArea(areaField, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(areaField, farrayPtr=dataptr1d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do g = begg, endg + ldomain%area(g) = dataptr1d(g-begg+1) * (re*re) + end do + call ESMF_FieldDestroy(areaField) + + ! If grid is 2d, determine lon1d and lat1d from mesh + if (isgrid2d) then + gsize = ni*nj + allocate(rtemp_glob(gsize)) + + ! Determine lon1d + allocate(lndlons_glob(gsize)) + lndlons_glob(:) = 0._r8 + do n = 1,numownedelements + if (ownedElemCoords(2*n-1) == 360._r8) then ! TODO: why is this needed? + lndlons_glob(gindex(n)) = 0._r8 + else + lndlons_glob(gindex(n)) = ownedElemCoords(2*n-1) + end if + end do + call ESMF_VMAllReduce(vm, sendData=lndlons_glob, recvData=rtemp_glob, count=gsize, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + deallocate(lndlons_glob) + allocate(lon1d(ni)) + do n = 1,ni + lon1d(n) = rtemp_glob(n) + end do + + ! Determine lat1d + allocate(lndlats_glob(gsize)) + lndlats_glob(:) = 0._r8 + do n = 1,numownedelements + lndlats_glob(gindex(n)) = ownedElemCoords(2*n) + end do + call ESMF_VMAllReduce(vm, sendData=lndlats_glob, recvData=rtemp_glob, count=gsize, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + deallocate(lndlats_glob) + allocate(lat1d(nj)) + do n = 1,nj + lat1d(n) = rtemp_glob((n-1)*ni + 1) + end do + deallocate(rtemp_glob) + end if + + end subroutine lnd_set_ldomain_gridinfo_from_mesh + + !=============================================================================== + subroutine pio_check_err(ierror, description) + use pio, only : PIO_NOERR + integer , intent(in) :: ierror + character(*), intent(in) :: description + if (ierror /= PIO_NOERR) then + write (*,'(6a)') 'ERROR ', trim(description) + call shr_sys_abort() + endif + end subroutine pio_check_err + + !=============================================================================== + logical function chkerr(rc, line, file) + integer , intent(in) :: rc + integer , intent(in) :: line + character(len=*) , intent(in) :: file + + integer :: lrc + chkerr = .false. + lrc = rc + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then + chkerr = .true. + endif + end function chkerr + + !=============================================================================== + subroutine lnd_set_read_write_landmask(write_file, read_file, lndmask_glob, lndfrac_glob, gsize) + + ! This subroutine is currently unused (as of 2021-03-17), but it may be needed in the + ! future. Its purpose is: Now that we get landmask and landfrac at runtime, from + ! mapping the ocean mask to the land grid, it's possible that landfrac will be + ! roundoff-level different with different processor counts. Mariana Vertenstein + ! hasn't seen this happen yet, but if it does, then we can use this subroutine to + ! solve this issue in tests that change processor count (ERP, PEM). I think Mariana's + ! intent was: in the first run, we would write landmask and landfrac to a landfrac.nc + ! file; then, in the second run (with different processor count), we would read that + ! file rather than doing the mapping again. This way, both runs of the ERP or PEM + ! test would use consistent landmask and landfrac values. + + use ncdio_pio , only : ncd_io, file_desc_t, ncd_pio_openfile, ncd_pio_closefile + use ncdio_pio , only : ncd_defdim, ncd_defvar, ncd_enddef, ncd_inqdlen + use ncdio_pio , only : ncd_int, ncd_double, ncd_pio_createfile + + ! input/output variables + logical , intent(in) :: write_file + logical , intent(in) :: read_file + integer , pointer :: lndmask_glob(:) + real(r8) , pointer :: lndfrac_glob(:) + integer , intent(in) :: gsize + + ! local variables + type(file_desc_t) :: pioid ! netcdf file id + integer :: dimid + character(len=CL) :: flandfrac = 'landfrac.nc' + !------------------------------------------------------------------------------- + + if (write_file) then + if (masterproc) then + write(iulog,*) + write(iulog,'(a)') 'lnd_set_decomp_and_domain: writing landmask and landfrac data to landfrac.nc' + write(iulog,*) + end if + call ncd_pio_createfile(pioid, trim(flandfrac)) + call ncd_defdim (pioid, 'gridcell', gsize, dimid) + call ncd_defvar(ncid=pioid, varname='landmask', xtype=ncd_int , dim1name='gridcell') + call ncd_defvar(ncid=pioid, varname='landfrac', xtype=ncd_double, dim1name='gridcell') + call ncd_enddef(pioid) + call ncd_io(ncid=pioid, varname='landmask', data=lndmask_glob, flag='write') + call ncd_io(ncid=pioid, varname='landfrac', data=lndfrac_glob, flag='write') + call ncd_pio_closefile(pioid) + else if (read_file) then + if (masterproc) then + write(iulog,*) + write(iulog,'(a)') 'lnd_set_decomp_and_domain: reading landmask and landfrac data from landfrac.nc' + write(iulog,*) + end if + call ncd_pio_openfile (pioid, trim(flandfrac), 0) + call ncd_io(ncid=pioid, varname='landmask', data=lndmask_glob, flag='read') + call ncd_io(ncid=pioid, varname='landfrac', data=lndfrac_glob, flag='read') + call ncd_pio_closefile(pioid) + end if + + end subroutine lnd_set_read_write_landmask + + +end module lnd_set_decomp_and_domain diff --git a/src/cpl/utils/lnd_import_export_utils.F90 b/src/cpl/utils/lnd_import_export_utils.F90 index c02e1a18dc..032cb19b6f 100644 --- a/src/cpl/utils/lnd_import_export_utils.F90 +++ b/src/cpl/utils/lnd_import_export_utils.F90 @@ -28,7 +28,6 @@ subroutine derive_quantities( bounds, atm2lnd_inst, wateratm2lndbulk_inst, & ! Convert the input data from the mediator to the land model !------------------------------------------------------------------------- - use clm_varctl, only: co2_ppmv use clm_varcon, only: rair, o2_molar_const use QSatMod, only: QSat @@ -74,7 +73,6 @@ subroutine derive_quantities( bounds, atm2lnd_inst, wateratm2lndbulk_inst, & (forc_pbot - 0.378_r8 * atm2lnd_inst%forc_vp_grc(g)) / (rair * forc_t) atm2lnd_inst%forc_po2_grc(g) = o2_molar_const * forc_pbot - atm2lnd_inst%forc_pco2_grc(g) = co2_ppmv * 1.e-6_r8 * forc_pbot atm2lnd_inst%forc_wind_grc(g) = sqrt(atm2lnd_inst%forc_u_grc(g)**2 + atm2lnd_inst%forc_v_grc(g)**2) @@ -86,15 +84,6 @@ subroutine derive_quantities( bounds, atm2lnd_inst, wateratm2lndbulk_inst, & call QSat(forc_t, forc_pbot, qsat_kg_kg) - ! modify specific humidity if precip occurs - if (1==2) then - if ((forc_rainc(g) + forc_rainl(g)) > 0._r8) then - forc_q = 0.95_r8 * qsat_kg_kg - !forc_q = qsat_kg_kg - wateratm2lndbulk_inst%forc_q_not_downscaled_grc(g) = forc_q - endif - endif - wateratm2lndbulk_inst%forc_rh_grc(g) = 100.0_r8*(forc_q / qsat_kg_kg) end do diff --git a/src/dyn_subgrid/dynConsBiogeophysMod.F90 b/src/dyn_subgrid/dynConsBiogeophysMod.F90 index 089715233d..bcbcc97c4b 100644 --- a/src/dyn_subgrid/dynConsBiogeophysMod.F90 +++ b/src/dyn_subgrid/dynConsBiogeophysMod.F90 @@ -37,7 +37,7 @@ module dynConsBiogeophysMod use ColumnType , only : col use PatchType , only : patch use clm_varcon , only : tfrz, cpliq, hfus, ispval - use landunit_varcon , only : istsoil, istice_mec + use landunit_varcon , only : istsoil, istice use dynSubgridControlMod , only : get_for_testing_zero_dynbal_fluxes use filterColMod , only : filter_col_type, col_filter_from_ltypes ! @@ -64,7 +64,7 @@ module dynConsBiogeophysMod contains !----------------------------------------------------------------------- - subroutine dyn_hwcontent_set_baselines(bounds, num_icemecc, filter_icemecc, & + subroutine dyn_hwcontent_set_baselines(bounds, num_icec, filter_icec, & num_lakec, filter_lakec, & urbanparams_inst, soilstate_inst, lakestate_inst, water_inst, temperature_inst, & reset_all_baselines, reset_lake_baselines) @@ -99,8 +99,8 @@ subroutine dyn_hwcontent_set_baselines(bounds, num_icemecc, filter_icemecc, & ! The following filter should include inactive as well as active points. This could ! be important if an inactive point later becomes active, so that we have an ! appropriate baseline value for that point. - integer, intent(in) :: num_icemecc ! number of points in filter_icemecc - integer, intent(in) :: filter_icemecc(:) ! filter for icemec (i.e., glacier) columns + integer, intent(in) :: num_icec ! number of points in filter_icec + integer, intent(in) :: filter_icec(:) ! filter for ice (i.e., glacier) columns integer, intent(in) :: num_lakec ! number of points in filter_lakec integer, intent(in) :: filter_lakec(:) ! filter for lake columns @@ -136,14 +136,14 @@ subroutine dyn_hwcontent_set_baselines(bounds, num_icemecc, filter_icemecc, & ! value for that point. natveg_and_glc_filterc = col_filter_from_ltypes( & bounds = bounds, & - ltypes = [istsoil, istice_mec], & + ltypes = [istsoil, istice], & include_inactive = .true.) do i = water_inst%bulk_and_tracers_beg, water_inst%bulk_and_tracers_end associate(bulk_or_tracer => water_inst%bulk_and_tracers(i)) call dyn_water_content_set_baselines(bounds, natveg_and_glc_filterc, & - num_icemecc, filter_icemecc, num_lakec, filter_lakec, & + num_icec, filter_icec, num_lakec, filter_lakec, & bulk_or_tracer%waterstate_inst, lakestate_inst, & reset_all_baselines = reset_all_baselines, & reset_lake_baselines = reset_lake_baselines) @@ -151,7 +151,7 @@ subroutine dyn_hwcontent_set_baselines(bounds, num_icemecc, filter_icemecc, & end do call dyn_heat_content_set_baselines(bounds, natveg_and_glc_filterc, & - num_icemecc, filter_icemecc, num_lakec, filter_lakec, & + num_icec, filter_icec, num_lakec, filter_lakec, & urbanparams_inst, soilstate_inst, lakestate_inst, water_inst%waterstatebulk_inst, & temperature_inst, & reset_all_baselines = reset_all_baselines, & @@ -161,7 +161,7 @@ end subroutine dyn_hwcontent_set_baselines !----------------------------------------------------------------------- subroutine dyn_water_content_set_baselines(bounds, natveg_and_glc_filterc, & - num_icemecc, filter_icemecc, num_lakec, filter_lakec, & + num_icec, filter_icec, num_lakec, filter_lakec, & waterstate_inst, lakestate_inst, & reset_all_baselines, reset_lake_baselines) ! @@ -174,8 +174,8 @@ subroutine dyn_water_content_set_baselines(bounds, natveg_and_glc_filterc, & type(filter_col_type), intent(in) :: natveg_and_glc_filterc ! filter for natural veg and glacier columns ! The following filter should include inactive as well as active points - integer, intent(in) :: num_icemecc ! number of points in filter_icemecc - integer, intent(in) :: filter_icemecc(:) ! filter for icemec (i.e., glacier) columns + integer, intent(in) :: num_icec ! number of points in filter_icec + integer, intent(in) :: filter_icec(:) ! filter for ice (i.e., glacier) columns integer, intent(in) :: num_lakec ! number of points in filter_lakec integer, intent(in) :: filter_lakec(:) ! filter for lake columns @@ -218,10 +218,10 @@ subroutine dyn_water_content_set_baselines(bounds, natveg_and_glc_filterc, & ! under the glacial ice. Let's assume that the soil state under each glacier column is ! the same as the soil state in the natural vegetation landunit on that grid cell. We ! subtract this from the dynbal baseline variables to indicate a missing stock. - call set_glacier_baselines(bounds, num_icemecc, filter_icemecc, & + call set_glacier_baselines(bounds, num_icec, filter_icec, & vals_col = soil_liquid_mass_col(bounds%begc:bounds%endc), & baselines_col = dynbal_baseline_liq(bounds%begc:bounds%endc)) - call set_glacier_baselines(bounds, num_icemecc, filter_icemecc, & + call set_glacier_baselines(bounds, num_icec, filter_icec, & vals_col = soil_ice_mass_col(bounds%begc:bounds%endc), & baselines_col = dynbal_baseline_ice(bounds%begc:bounds%endc)) end if @@ -251,7 +251,7 @@ end subroutine dyn_water_content_set_baselines !----------------------------------------------------------------------- subroutine dyn_heat_content_set_baselines(bounds, natveg_and_glc_filterc, & - num_icemecc, filter_icemecc, num_lakec, filter_lakec, & + num_icec, filter_icec, num_lakec, filter_lakec, & urbanparams_inst, soilstate_inst, lakestate_inst, waterstatebulk_inst, & temperature_inst, & reset_all_baselines, reset_lake_baselines) @@ -264,10 +264,10 @@ subroutine dyn_heat_content_set_baselines(bounds, natveg_and_glc_filterc, & type(filter_col_type), intent(in) :: natveg_and_glc_filterc ! filter for natural veg and glacier columns ! The following filter should include inactive as well as active points - integer, intent(in) :: num_icemecc ! number of points in filter_icemecc - integer, intent(in) :: filter_icemecc(:) ! filter for icemec (i.e., glacier) columns - integer, intent(in) :: num_lakec ! number of points in filter_lakec - integer, intent(in) :: filter_lakec(:) ! filter for lake columns + integer, intent(in) :: num_icec ! number of points in filter_icec + integer, intent(in) :: filter_icec(:) ! filter for ice (i.e., glacier) columns + integer, intent(in) :: num_lakec ! number of points in filter_lakec + integer, intent(in) :: filter_lakec(:) ! filter for lake columns type(urbanparams_type), intent(in) :: urbanparams_inst type(soilstate_type) , intent(in) :: soilstate_inst @@ -319,7 +319,7 @@ subroutine dyn_heat_content_set_baselines(bounds, natveg_and_glc_filterc, & ! energy (or water) content of a given column (as long as that baseline doesn't ! change over time). By using the baselines computed here, we reduce the dynbal ! fluxes to more reasonable values. - call set_glacier_baselines(bounds, num_icemecc, filter_icemecc, & + call set_glacier_baselines(bounds, num_icec, filter_icec, & vals_col = soil_heat_col(bounds%begc:bounds%endc), & baselines_col = dynbal_baseline_heat(bounds%begc:bounds%endc)) end if @@ -344,7 +344,7 @@ subroutine dyn_heat_content_set_baselines(bounds, natveg_and_glc_filterc, & end subroutine dyn_heat_content_set_baselines !----------------------------------------------------------------------- - subroutine set_glacier_baselines(bounds, num_icemecc, filter_icemecc, & + subroutine set_glacier_baselines(bounds, num_icec, filter_icec, & vals_col, baselines_col) ! ! !DESCRIPTION: @@ -358,11 +358,11 @@ subroutine set_glacier_baselines(bounds, num_icemecc, filter_icemecc, & type(bounds_type), intent(in) :: bounds ! The following filter should include inactive as well as active points - integer, intent(in) :: num_icemecc ! number of points in filter_icemecc - integer, intent(in) :: filter_icemecc(:) ! filter for icemec (i.e., glacier) columns + integer, intent(in) :: num_icec ! number of points in filter_icec + integer, intent(in) :: filter_icec(:) ! filter for ice (i.e., glacier) columns real(r8), intent(in) :: vals_col( bounds%begc: ) ! values in each column; must be set for at least natural veg and glacier columns - real(r8), intent(inout) :: baselines_col( bounds%begc: ) ! baselines in each column; will be set for all points in the icemecc filter + real(r8), intent(inout) :: baselines_col( bounds%begc: ) ! baselines in each column; will be set for all points in the icec filter ! ! !LOCAL VARIABLES: integer :: fc, c, l, g ! indices @@ -391,8 +391,8 @@ subroutine set_glacier_baselines(bounds, num_icemecc, filter_icemecc, & c2l_scale_type = 'urbanf', & include_inactive = .true.) - do fc = 1, num_icemecc - c = filter_icemecc(fc) + do fc = 1, num_icec + c = filter_icec(fc) g = col%gridcell(c) ! Start by setting the baseline for this glacier column equal to the value in this diff --git a/src/dyn_subgrid/dynInitColumnsMod.F90 b/src/dyn_subgrid/dynInitColumnsMod.F90 index ec191183ff..f135ec0cc1 100644 --- a/src/dyn_subgrid/dynInitColumnsMod.F90 +++ b/src/dyn_subgrid/dynInitColumnsMod.F90 @@ -97,7 +97,7 @@ function initial_template_col_dispatcher(bounds, c_new, cactive_prior) result(c_ ! Returns TEMPLATE_NONE_FOUND if there is no column to use for initialization ! ! !USES: - use landunit_varcon, only : istsoil, istcrop, istice_mec, istdlak, istwet, isturb_MIN, isturb_MAX + use landunit_varcon, only : istsoil, istcrop, istice, istdlak, istwet, isturb_MIN, isturb_MAX ! ! !ARGUMENTS: integer :: c_template ! function result @@ -121,7 +121,7 @@ function initial_template_col_dispatcher(bounds, c_new, cactive_prior) result(c_ 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_mec) + case(istice) 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(sourcefile, __LINE__)) diff --git a/src/dyn_subgrid/dynLandunitAreaMod.F90 b/src/dyn_subgrid/dynLandunitAreaMod.F90 index c38e52b9d8..85d562c5b9 100644 --- a/src/dyn_subgrid/dynLandunitAreaMod.F90 +++ b/src/dyn_subgrid/dynLandunitAreaMod.F90 @@ -109,9 +109,9 @@ subroutine update_landunit_weights_one_gcell(landunit_weights) ! 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 + ! that istice doesn't appear here, so that the istice 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 + ! one landunit is excluded from this list. Meaning: since istice is excluded from ! this list, all other landunits should appear in this list! integer, parameter :: decrease_order(7) = & (/istsoil, istcrop, isturb_md, isturb_hd, isturb_tbd, istwet, istdlak/) diff --git a/src/dyn_subgrid/test/dynConsBiogeophys_test/test_dyn_cons_biogeophys.pf b/src/dyn_subgrid/test/dynConsBiogeophys_test/test_dyn_cons_biogeophys.pf index 47f802e5bf..7a847c24c4 100644 --- a/src/dyn_subgrid/test/dynConsBiogeophys_test/test_dyn_cons_biogeophys.pf +++ b/src/dyn_subgrid/test/dynConsBiogeophys_test/test_dyn_cons_biogeophys.pf @@ -9,9 +9,9 @@ module test_dyn_cons_biogeophys use unittestArrayMod, only : col_array use unittestFilterBuilderMod, only : filter_from_range, filter_empty use unittestWaterTypeFactory, only : unittest_water_type_factory_type - use clm_varpar, only : nlevgrnd, nlevsno, maxpatch_glcmec - use column_varcon, only : icemec_class_to_col_itype - use landunit_varcon, only : istsoil, istice_mec, istdlak + use clm_varpar, only : nlevgrnd, nlevsno, maxpatch_glc + use column_varcon, only : ice_class_to_col_itype + use landunit_varcon, only : istsoil, istice, istdlak use ColumnType, only : col use LandunitType, only : lun use PatchType, only : patch @@ -49,7 +49,7 @@ contains subroutine setUp(this) class(TestDCB), intent(inout) :: this - maxpatch_glcmec = 10 + maxpatch_glc = 10 call this%water_type_factory%init() call this%water_type_factory%setup_before_subgrid( & my_nlevsoi = my_nlevsoi, & @@ -101,8 +101,8 @@ contains real(r8), parameter :: wt_veg_col1 = 0.25_r8 real(r8), parameter :: wt_veg_col2 = 0.75_r8 integer :: veg_col1, veg_col2, glc_col - integer :: num_icemecc, num_natveg_and_icemecc, num_lakec - integer, allocatable :: filter_icemecc(:), filter_natveg_and_icemecc(:), filter_lakec(:) + integer :: num_icec, num_natveg_and_icec, num_lakec + integer, allocatable :: filter_icec(:), filter_natveg_and_icec(:), filter_lakec(:) integer :: c real(r8), allocatable :: expected_vals_liq_col(:) real(r8), allocatable :: expected_vals_ice_col(:) @@ -113,7 +113,7 @@ contains ! ------------------------------------------------------------------------ ! Create subgrid structure. ! - ! There is one ice_mec column (the target column for this test) and two vegetated + ! There is one ice column (the target column for this test) and two vegetated ! columns (to test averaging from column to landunit). The weights of all of those ! columns on the grid cell are 0, and they are all inactive (in order to ensure that ! the code operates on inactive as well as active points). In addition, there is one @@ -134,9 +134,9 @@ contains veg_col2 = ci ! Add glacier landunit - call unittest_add_landunit(my_gi=gi, ltype=istice_mec, wtgcell=0._r8) + call unittest_add_landunit(my_gi=gi, ltype=istice, wtgcell=0._r8) call unittest_add_column(my_li=li, & - ctype = icemec_class_to_col_itype(1), & + ctype = ice_class_to_col_itype(1), & wtlunit=1._r8) call unittest_add_patch(my_ci=ci, ptype=0, wtcol=1._r8) glc_col = ci @@ -159,9 +159,9 @@ contains ! Create filters call filter_from_range(start=glc_col, end=glc_col, & - numf=num_icemecc, filter=filter_icemecc) + numf=num_icec, filter=filter_icec) call filter_from_range(start=veg_col1, end=glc_col, & - numf=num_natveg_and_icemecc, filter=filter_natveg_and_icemecc) + numf=num_natveg_and_icec, filter=filter_natveg_and_icec) ! For now, this test does NOT cover lake columns. So just use an empty lake filter. ! This also allows us to avoid initializing variables in this%lakestate_inst. call filter_empty(num_lakec, filter_lakec) @@ -207,7 +207,7 @@ contains ! Call the routine we're testing ! ------------------------------------------------------------------------ - call dyn_hwcontent_set_baselines(bounds, num_icemecc, filter_icemecc, & + call dyn_hwcontent_set_baselines(bounds, num_icec, filter_icec, & num_lakec, filter_lakec, & this%urbanparams_inst, this%soilstate_inst, this%lakestate_inst, & this%water_inst, this%temperature_inst, & @@ -228,13 +228,13 @@ contains ignored_cvliq_col = col_array(0._r8) call AccumulateSoilLiqIceMassNonLake(bounds, & - num_natveg_and_icemecc, filter_natveg_and_icemecc, & + num_natveg_and_icec, filter_natveg_and_icec, & this%water_inst%waterstatebulk_inst, & liquid_mass = expected_vals_liq_col, & ice_mass = expected_vals_ice_col) call AccumulateSoilHeatNonLake(bounds, & - num_natveg_and_icemecc, filter_natveg_and_icemecc, & + num_natveg_and_icec, filter_natveg_and_icec, & this%urbanparams_inst, this%soilstate_inst, this%temperature_inst, & this%water_inst%waterstatebulk_inst, & heat = expected_vals_heat_col, & diff --git a/src/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights.pf b/src/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights.pf index 4cc250320b..7bfc76429b 100644 --- a/src/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights.pf +++ b/src/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights.pf @@ -6,7 +6,7 @@ module test_update_landunit_weights use unittestSubgridMod use dynLandunitAreaMod use shr_kind_mod , only : r8 => shr_kind_r8 - use landunit_varcon , only : istsoil, istcrop, istice_mec, istdlak, istwet + use landunit_varcon , only : istsoil, istcrop, istice, istdlak, istwet use landunit_varcon , only : isturb_tbd, isturb_hd, isturb_md use GridcellType , only : grc use LandunitType , only : lun @@ -37,7 +37,7 @@ contains ! Test update_landunit_weights with a single grid cell, which has all landunits ! present - integer :: index_soil, index_crop, index_icemec, index_urbmd + integer :: index_soil, index_crop, index_ice, index_urbmd real(r8) :: expected(begl:endl) call setup_start() @@ -57,12 +57,12 @@ contains ! 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 + ! First increase the area of istice: weights of istice + 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_ice = grc%landunit_indices(istice,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 + lun%wtgcell(index_ice) = lun%wtgcell(index_ice) + lun%wtgcell(index_soil) + lun%wtgcell(index_crop) + 0.01_r8 ! Now set the expected outcome expected = lun%wtgcell @@ -81,21 +81,21 @@ contains ! Test update_landunit_weights with a single grid cell, which has only some landunits ! present - integer :: index_wet, index_icemec, index_crop + integer :: index_wet, index_ice, 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=istice, wtgcell=0.8_r8) + index_ice = 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_ice) = 0.8_r8 expected(index_crop) = 0.0_r8 expected(index_wet) = 0.2_r8 @@ -122,10 +122,10 @@ contains 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=g2, ltype=istice, 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=g3, ltype=istice, 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) diff --git a/src/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights_one_gcell.pf b/src/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights_one_gcell.pf index f0563130f3..03ee916a06 100644 --- a/src/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights_one_gcell.pf +++ b/src/dyn_subgrid/test/dynLandunitArea_test/test_update_landunit_weights_one_gcell.pf @@ -4,7 +4,7 @@ module test_update_landunit_weights_one_gcell use pfunit_mod use dynLandunitAreaMod - use landunit_varcon, only : istsoil, istcrop, isturb_md, istice_mec, istdlak, max_lunit + use landunit_varcon, only : istsoil, istcrop, isturb_md, istice, istdlak, max_lunit use shr_kind_mod , only : r8 => shr_kind_r8 @@ -46,7 +46,7 @@ contains real(r8) :: expected(max_lunit) landunit_weights = create_landunit_weights() - landunit_weights(istice_mec) = landunit_weights(istice_mec) - 0.01_r8 + landunit_weights(istice) = landunit_weights(istice) - 0.01_r8 expected = landunit_weights expected(istsoil) = landunit_weights(istsoil) + 0.01_r8 @@ -63,7 +63,7 @@ contains real(r8) :: expected(max_lunit) landunit_weights = create_landunit_weights() - landunit_weights(istice_mec) = landunit_weights(istice_mec) + 0.01_r8 + landunit_weights(istice) = landunit_weights(istice) + 0.01_r8 expected = landunit_weights expected(istsoil) = landunit_weights(istsoil) - 0.01_r8 @@ -83,7 +83,7 @@ contains ! 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(istice) = landunit_weights(istice) + & landunit_weights(istsoil) + landunit_weights(istcrop) + 0.01_r8 expected = landunit_weights expected(istsoil) = 0._r8 @@ -97,18 +97,18 @@ contains @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 + ! landunits (except istice, 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 + landunit_weights(istice) = 0.99_r8 ! In the following, we assume that the last element of decrease_order is istdlak expected(:) = 0._r8 - expected(istice_mec) = 0.99_r8 + expected(istice) = 0.99_r8 expected(istdlak) = 0.01_r8 call update_landunit_weights_one_gcell(landunit_weights) @@ -117,16 +117,16 @@ contains @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 + ! Similar to test_greater_than_1_all_changes, but now all landunits except istice ! 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 + landunit_weights(istice) = 1.0_r8 expected(:) = 0._r8 - expected(istice_mec) = 1.0_r8 + expected(istice) = 1.0_r8 call update_landunit_weights_one_gcell(landunit_weights) @assertEqual(expected, landunit_weights, tolerance=tol) diff --git a/src/init_interp/initInterp.F90 b/src/init_interp/initInterp.F90 index 0e6e8da6e2..343f1b9ea8 100644 --- a/src/init_interp/initInterp.F90 +++ b/src/init_interp/initInterp.F90 @@ -210,6 +210,7 @@ subroutine initInterp (filei, fileo, bounds, glc_behavior) integer :: npftsi, ncolsi, nlunsi, ngrcsi integer :: npftso, ncolso, nlunso, ngrcso logical :: glc_elevclasses_same + logical :: att_found integer , allocatable, target :: pftindx(:) integer , allocatable, target :: colindx(:) integer , allocatable, target :: lunindx(:) @@ -292,9 +293,25 @@ subroutine initInterp (filei, fileo, bounds, glc_behavior) status = pio_get_att(ncidi, pio_global, & 'ilun_crop', & subgrid_special_indices%ilun_crop) - status = pio_get_att(ncidi, pio_global, & - 'ilun_landice_multiple_elevation_classes', & - subgrid_special_indices%ilun_landice_multiple_elevation_classes) + + ! BACKWARDS_COMPATIBILITY(wjs, 2021-04-16) ilun_landice_multiple_elevation_classes has + ! been renamed to ilun_landice. For now we need to handle both possibilities for the + ! sake of old initial conditions files. There is a chance that we had ilun_landice + ! alongside ilun_landice_multiple_elevation_classes on really old initial conditions + ! files; in that case, we want to use ilun_landice_multiple_elevation_classes. Once we + ! can rely on all initial conditions files having the new behavior, we can remove this + ! check_att call and just assume there is an ilun_landice attribute. + call check_att(ncidi, pio_global, 'ilun_landice_multiple_elevation_classes', att_found) + if (att_found) then + status = pio_get_att(ncidi, pio_global, & + 'ilun_landice_multiple_elevation_classes', & + subgrid_special_indices%ilun_landice) + else + status = pio_get_att(ncidi, pio_global, & + 'ilun_landice', & + subgrid_special_indices%ilun_landice) + end if + status = pio_get_att(ncidi, pio_global, & 'created_glacier_mec_landunits', & created_glacier_mec_landunits) @@ -308,8 +325,8 @@ subroutine initInterp (filei, fileo, bounds, glc_behavior) subgrid_special_indices%ilun_vegetated_or_bare_soil write(iulog,*)'ilun_crop = ' , & subgrid_special_indices%ilun_crop - write(iulog,*)'ilun_landice_multiple_elevation_classes = ' , & - subgrid_special_indices%ilun_landice_multiple_elevation_classes + write(iulog,*)'ilun_landice = ' , & + subgrid_special_indices%ilun_landice write(iulog,*)'create_glacier_mec_landunits = ', & trim(created_glacier_mec_landunits) end if diff --git a/src/init_interp/initInterpMindist.F90 b/src/init_interp/initInterpMindist.F90 index baef369ea5..f6853b1cd3 100644 --- a/src/init_interp/initInterpMindist.F90 +++ b/src/init_interp/initInterpMindist.F90 @@ -34,7 +34,7 @@ module initInterpMindist integer :: icol_vegetated_or_bare_soil integer :: ilun_vegetated_or_bare_soil integer :: ilun_crop - integer :: ilun_landice_multiple_elevation_classes + integer :: ilun_landice contains procedure :: is_vegetated_landunit ! returns true if the given landunit type is natural veg or crop end type subgrid_special_indices_type @@ -55,8 +55,8 @@ module initInterpMindist ! Private methods - private :: set_glcmec_must_be_same_type - private :: set_icemec_adjustable_type + private :: set_glc_must_be_same_type + private :: set_ice_adjustable_type private :: do_fill_missing_with_natveg private :: is_sametype private :: is_baresoil @@ -183,10 +183,10 @@ subroutine set_mindist(begi, endi, bego, endo, activei, activeo, subgridi, subgr logical :: topoglc_present logical :: closest - ! Whether two glcmec columns/patches must be the same column/patch type to be - ! considered the same type. This is only valid for glcmec points, and is only valid + ! Whether two glc columns/patches must be the same column/patch type to be + ! considered the same type. This is only valid for glc points, and is only valid ! for subgrid name = 'pft' or 'column'. - logical :: glcmec_must_be_same_type_o(bego:endo) + logical :: glc_must_be_same_type_o(bego:endo) ! -------------------------------------------------------------------- if (associated(subgridi%topoglc) .and. associated(subgrido%topoglc)) then @@ -198,9 +198,9 @@ subroutine set_mindist(begi, endi, bego, endo, activei, activeo, subgridi, subgr mindist_index(bego:endo) = 0 distmin = spval - call set_glcmec_must_be_same_type(bego=bego, endo=endo, dimname=subgrido%name, & + call set_glc_must_be_same_type(bego=bego, endo=endo, dimname=subgrido%name, & glc_elevclasses_same = glc_elevclasses_same, glc_behavior=glc_behavior, & - glcmec_must_be_same_type_o=glcmec_must_be_same_type_o) + glc_must_be_same_type_o=glc_must_be_same_type_o) !$OMP PARALLEL DO PRIVATE (ni,no,n,nmin,distmin,dx,dy,dist,closest,hgtdiffmin,hgtdiff) do no = bego,endo @@ -220,7 +220,7 @@ subroutine set_mindist(begi, endi, bego, endo, activei, activeo, subgridi, subgr if (is_sametype(ni = ni, no = no, & subgridi = subgridi, subgrido = subgrido, & subgrid_special_indices = subgrid_special_indices, & - glcmec_must_be_same_type = glcmec_must_be_same_type_o(no), & + glc_must_be_same_type = glc_must_be_same_type_o(no), & veg_patch_just_considers_ptype = .true.)) then dy = abs(subgrido%lat(no)-subgridi%lat(ni))*re dx = abs(subgrido%lon(no)-subgridi%lon(ni))*re * & @@ -239,7 +239,7 @@ subroutine set_mindist(begi, endi, bego, endo, activei, activeo, subgridi, subgr end if end if if (.not. closest) then - ! In *some* cases: For glc_mec points, we first find the closest + ! In *some* cases: For glacier points, we first find the closest ! point in lat-lon space, without consideration for column or patch ! type (above). Then, within that closest point, we find the closest ! column in topographic space; this second piece is done here. Note @@ -344,10 +344,10 @@ subroutine set_single_match(begi, endi, bego, endo, activeo, subgridi, subgrido, real(r8) :: dx, dy logical :: ni_sametype - ! Whether two glcmec columns/patches must be the same column/patch type to be - ! considered the same type. This is only valid for glcmec points, and is only valid + ! Whether two glc columns/patches must be the same column/patch type to be + ! considered the same type. This is only valid for glc points, and is only valid ! for subgrid name = 'pft' or 'column'. - logical :: glcmec_must_be_same_type_o(bego:endo) + logical :: glc_must_be_same_type_o(bego:endo) ! Tolerance in lat/lon for considering a point to be at the same location real(r8) :: same_point_tol = 1.e-14_r8 @@ -362,9 +362,9 @@ subroutine set_single_match(begi, endi, bego, endo, activeo, subgridi, subgrido, call endrun(msg=subname//' ERROR: glc_elevclasses_same must be true for this method') end if - call set_glcmec_must_be_same_type(bego=bego, endo=endo, dimname=subgrido%name, & + call set_glc_must_be_same_type(bego=bego, endo=endo, dimname=subgrido%name, & glc_elevclasses_same = glc_elevclasses_same, glc_behavior=glc_behavior, & - glcmec_must_be_same_type_o=glcmec_must_be_same_type_o) + glc_must_be_same_type_o=glc_must_be_same_type_o) !$OMP PARALLEL DO PRIVATE (ni,no,ni_match,found,dx,dy,ni_sametype) do no = bego, endo @@ -377,7 +377,7 @@ subroutine set_single_match(begi, endi, bego, endo, activeo, subgridi, subgrido, ni_sametype = is_sametype(ni = ni, no = no, & subgridi = subgridi, subgrido = subgrido, & subgrid_special_indices = subgrid_special_indices, & - glcmec_must_be_same_type = glcmec_must_be_same_type_o(no), & + glc_must_be_same_type = glc_must_be_same_type_o(no), & veg_patch_just_considers_ptype = .false.) if (ni_sametype) then if (found) then @@ -426,16 +426,16 @@ subroutine set_single_match(begi, endi, bego, endo, activeo, subgridi, subgrido, end subroutine set_single_match !----------------------------------------------------------------------- - subroutine set_glcmec_must_be_same_type(bego, endo, dimname, & + subroutine set_glc_must_be_same_type(bego, endo, dimname, & glc_elevclasses_same, glc_behavior, & - glcmec_must_be_same_type_o) + glc_must_be_same_type_o) ! ! !DESCRIPTION: - ! Sets the glcmec_must_be_same_type_o array for each output icemec point + ! Sets the glc_must_be_same_type_o array for each output ice point ! - ! This array will be set to true for icemec output columns/patches for which the + ! This array will be set to true for ice output columns/patches for which the ! column/patch type must match the input column/patch type to be considered the same - ! type. This is only valid for icemec points, and is only valid for dimname = 'pft' or + ! type. This is only valid for ice points, and is only valid for dimname = 'pft' or ! 'column' - for others, the value is undefined. ! ! This assumes that bego and endo match the bounds that are used elsewhere in the @@ -453,62 +453,62 @@ subroutine set_glcmec_must_be_same_type(bego, endo, dimname, & type(glc_behavior_type), intent(in) :: glc_behavior - logical, intent(out) :: glcmec_must_be_same_type_o( bego: ) ! see description above + logical, intent(out) :: glc_must_be_same_type_o( bego: ) ! see description above ! ! !LOCAL VARIABLES: integer :: no - ! Whether each output icemec point has adjustable column type; only valid for icemec + ! Whether each output ice point has adjustable column type; only valid for ice ! points, and only valid for subgrid name = pft or column - logical :: icemec_adjustable_type_o(bego:endo) + logical :: ice_adjustable_type_o(bego:endo) - character(len=*), parameter :: subname = 'set_glcmec_must_be_same_type' + character(len=*), parameter :: subname = 'set_glc_must_be_same_type' !----------------------------------------------------------------------- - SHR_ASSERT_ALL_FL((ubound(glcmec_must_be_same_type_o) == (/endo/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(glc_must_be_same_type_o) == (/endo/)), sourcefile, __LINE__) if (.not. glc_elevclasses_same) then ! If the number or bounds of the elevation classes differ between input and - ! output, then we ignore the column and patch types of glcmec points when + ! output, then we ignore the column and patch types of glc points when ! looking for the same type - instead using closest topographic height as a ! tie-breaker between equidistant columns/patches. - glcmec_must_be_same_type_o(bego:endo) = .false. + glc_must_be_same_type_o(bego:endo) = .false. else - call set_icemec_adjustable_type(bego=bego, endo=endo, dimname=dimname, & - glc_behavior=glc_behavior, icemec_adjustable_type_o=icemec_adjustable_type_o) + call set_ice_adjustable_type(bego=bego, endo=endo, dimname=dimname, & + glc_behavior=glc_behavior, ice_adjustable_type_o=ice_adjustable_type_o) do no = bego, endo - if (icemec_adjustable_type_o(no)) then - ! If glcmec points in this output cell have adjustable type, then we ignore - ! the column and patch types of glcmec points when looking for the same - ! type: we want to find the closest glcmec point in lat-lon space without + if (ice_adjustable_type_o(no)) then + ! If glc points in this output cell have adjustable type, then we ignore + ! the column and patch types of glc points when looking for the same + ! type: we want to find the closest glc point in lat-lon space without ! regards for column/patch type, because the column/patch types may change ! at runtime. - glcmec_must_be_same_type_o(no) = .false. + glc_must_be_same_type_o(no) = .false. else ! Otherwise, we require the column and patch types to be the same between - ! input and output for this glcmec output point, as is the case for most + ! input and output for this glc output point, as is the case for most ! other landunits. This is important for a case with interpolation to give - ! bit-for-bit answers with a case without interpolation (since glcmec + ! bit-for-bit answers with a case without interpolation (since glc ! topographic heights can change after initialization, so we can't always ! rely on the point with closest topographic height to be the "right" one to ! pick as the source for interpolation). - glcmec_must_be_same_type_o(no) = .true. + glc_must_be_same_type_o(no) = .true. end if end do end if - end subroutine set_glcmec_must_be_same_type + end subroutine set_glc_must_be_same_type !----------------------------------------------------------------------- - subroutine set_icemec_adjustable_type(bego, endo, dimname, glc_behavior, & - icemec_adjustable_type_o) + subroutine set_ice_adjustable_type(bego, endo, dimname, glc_behavior, & + ice_adjustable_type_o) ! ! !DESCRIPTION: - ! Sets the icemec_adjustable_type_o array for each output icemec point + ! Sets the ice_adjustable_type_o array for each output ice point ! - ! This array will be set to true for icemec points that have adjustable column type - ! and false for icemec points that do not. The value will be undefined for non-icemec + ! This array will be set to true for ice points that have adjustable column type + ! and false for ice points that do not. The value will be undefined for non-ice ! points. ! ! This can only be called for the output, not the input! @@ -525,30 +525,30 @@ subroutine set_icemec_adjustable_type(bego, endo, dimname, glc_behavior, & integer , intent(in) :: endo ! ending index for output points character(len=*) , intent(in) :: dimname ! 'pft', 'column', etc. type(glc_behavior_type) , intent(in) :: glc_behavior - logical , intent(out) :: icemec_adjustable_type_o( bego: ) ! see documentation above + logical , intent(out) :: ice_adjustable_type_o( bego: ) ! see documentation above ! ! !LOCAL VARIABLES: - character(len=*), parameter :: subname = 'set_icemec_adjustable_type' + character(len=*), parameter :: subname = 'set_ice_adjustable_type' !----------------------------------------------------------------------- - SHR_ASSERT_ALL_FL((ubound(icemec_adjustable_type_o) == (/endo/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(ice_adjustable_type_o) == (/endo/)), sourcefile, __LINE__) select case (dimname) case ('pft') call glc_behavior%patches_have_dynamic_type_array(bego, endo, & - icemec_adjustable_type_o(bego:endo)) + ice_adjustable_type_o(bego:endo)) case ('column') call glc_behavior%cols_have_dynamic_type_array(bego, endo, & - icemec_adjustable_type_o(bego:endo)) + ice_adjustable_type_o(bego:endo)) case ('landunit', 'gridcell') - ! Do nothing: icemec_adjustable_type_o will be left undefined + ! Do nothing: ice_adjustable_type_o will be left undefined case default call endrun(subname//' ERROR: unexpected dimname: '//trim(dimname)//& errMsg(sourcefile, __LINE__)) end select - end subroutine set_icemec_adjustable_type + end subroutine set_ice_adjustable_type !----------------------------------------------------------------------- function do_fill_missing_with_natveg(fill_missing_with_natveg, & @@ -595,7 +595,7 @@ end function do_fill_missing_with_natveg !======================================================================= logical function is_sametype (ni, no, subgridi, subgrido, subgrid_special_indices, & - glcmec_must_be_same_type, veg_patch_just_considers_ptype) + glc_must_be_same_type, veg_patch_just_considers_ptype) ! -------------------------------------------------------------------- ! arguments @@ -605,10 +605,10 @@ logical function is_sametype (ni, no, subgridi, subgrido, subgrid_special_indice type(subgrid_type), intent(in) :: subgrido type(subgrid_special_indices_type), intent(in) :: subgrid_special_indices - ! Whether two glcmec columns/patches must be the same column/patch type to be - ! considered the same type. This is only valid for glcmec points, and is only valid + ! Whether two glc columns/patches must be the same column/patch type to be + ! considered the same type. This is only valid for glc points, and is only valid ! for subgrid name = 'pft' or 'column'. - logical, intent(in) :: glcmec_must_be_same_type + logical, intent(in) :: glc_must_be_same_type ! For vegetated patches (natural veg or crop): if veg_patch_just_considers_ptype is ! true, then we consider two vegetated patches to be the same type if they have the @@ -625,9 +625,9 @@ logical function is_sametype (ni, no, subgridi, subgrido, subgrid_special_indice is_sametype = .false. if (trim(subgridi%name) == 'pft' .and. trim(subgrido%name) == 'pft') then - if ( .not. glcmec_must_be_same_type .and. & - subgridi%ltype(ni) == subgrid_special_indices%ilun_landice_multiple_elevation_classes .and. & - subgrido%ltype(no) == subgrid_special_indices%ilun_landice_multiple_elevation_classes) then + if ( .not. glc_must_be_same_type .and. & + subgridi%ltype(ni) == subgrid_special_indices%ilun_landice .and. & + subgrido%ltype(no) == subgrid_special_indices%ilun_landice) then is_sametype = .true. else if (veg_patch_just_considers_ptype .and. & subgrid_special_indices%is_vegetated_landunit(subgrido%ltype(no))) then @@ -650,9 +650,9 @@ logical function is_sametype (ni, no, subgridi, subgrido, subgrid_special_indice is_sametype = .true. end if else if (trim(subgridi%name) == 'column' .and. trim(subgrido%name) == 'column') then - if ( .not. glcmec_must_be_same_type .and. & - subgridi%ltype(ni) == subgrid_special_indices%ilun_landice_multiple_elevation_classes .and. & - subgrido%ltype(no) == subgrid_special_indices%ilun_landice_multiple_elevation_classes ) then + if ( .not. glc_must_be_same_type .and. & + subgridi%ltype(ni) == subgrid_special_indices%ilun_landice .and. & + subgrido%ltype(no) == subgrid_special_indices%ilun_landice ) then is_sametype = .true. else if (subgridi%ctype(ni) == subgrido%ctype(no) .and. & subgridi%ltype(ni) == subgrido%ltype(no)) then diff --git a/src/init_interp/initInterpUtils.F90 b/src/init_interp/initInterpUtils.F90 index 13fa17f28a..f8f6acbed9 100644 --- a/src/init_interp/initInterpUtils.F90 +++ b/src/init_interp/initInterpUtils.F90 @@ -53,10 +53,10 @@ logical function glc_elevclasses_are_same(ncidi, ncido) !----------------------------------------------------------------------- ! BACKWARDS_COMPATIBILITY(wjs, 2018-03-19) Old restart files generated from - ! configurations with istice rather than istice_mec don't have a 'glc_nec' dimension. + ! configurations with istice rather than istice don't have a 'glc_nec' dimension. ! Users may still be using files generated like that. The value of this function ! should be irrelevant in that case. We can remove this code once we can rely on all - ! users' finidat files having been generated from configurations with istice_mec. + ! users' finidat files having been generated from configurations with istice. call ncd_inqdid(ncidi, 'glc_nec', dimid_dummy, dimexist=dimexist) if (.not. dimexist) then glc_elevclasses_are_same = .false. diff --git a/src/init_interp/test/initInterpMindist_test/initInterpMindistTestUtils.pf b/src/init_interp/test/initInterpMindist_test/initInterpMindistTestUtils.pf index 0da4e8099d..83f524c5d8 100644 --- a/src/init_interp/test/initInterpMindist_test/initInterpMindistTestUtils.pf +++ b/src/init_interp/test/initInterpMindist_test/initInterpMindistTestUtils.pf @@ -21,7 +21,7 @@ module initInterpMindistTestUtils icol_vegetated_or_bare_soil = 10, & ilun_vegetated_or_bare_soil = 3, & ilun_crop = 4, & - ilun_landice_multiple_elevation_classes = 5) + ilun_landice = 5) ! value we can use for a special landunit; note that this just needs to differ from ! ilun_vegetated_or_bare_soil and from ilun_crop diff --git a/src/init_interp/test/initInterpMindist_test/test_set_mindist.pf b/src/init_interp/test/initInterpMindist_test/test_set_mindist.pf index 4ae1171c47..67509c35af 100644 --- a/src/init_interp/test/initInterpMindist_test/test_set_mindist.pf +++ b/src/init_interp/test/initInterpMindist_test/test_set_mindist.pf @@ -126,14 +126,14 @@ contains end subroutine wrap_set_mindist !----------------------------------------------------------------------- - subroutine setup_and_run_glcmec(ptype_o, ctype_o, topoglc_o, & + subroutine setup_and_run_glc(ptype_o, ctype_o, topoglc_o, & ptype_i, ctype_i, topoglc_i, & collapse_to_atm_topo, glc_elevclasses_same, & mindist_index_p, mindist_index_c, & ltype_diff_i) ! ! !DESCRIPTION: - ! Does all the work needed to setup and run wrap_set_mindist for a single glcmec + ! Does all the work needed to setup and run wrap_set_mindist for a single glc ! output point. ! ! Gives both the mindist patch and column for that output point. @@ -155,15 +155,15 @@ contains integer, intent(out) :: mindist_index_p integer, intent(out) :: mindist_index_c - ! If present, this gives the difference in ltype from ltype_glcmec for each input + ! If present, this gives the difference in ltype from ltype_glc for each input ! point. So, for example, if this is an array [-1, 0, 1] then the input ltypes will - ! be [ltype_glcmec-1, ltype_glcmec, ltype_glcmec+1]. If absent, all input points have - ! type ltype_glcmec. + ! be [ltype_glc-1, ltype_glc, ltype_glc+1]. If absent, all input points have + ! type ltype_glc. integer, intent(in), optional :: ltype_diff_i(:) ! ! !LOCAL VARIABLES: - integer, parameter :: ltype_glcmec = subgrid_special_indices%ilun_landice_multiple_elevation_classes + integer, parameter :: ltype_glc = subgrid_special_indices%ilun_landice real(r8), parameter :: my_lat = 31._r8 real(r8), parameter :: my_lon = 41._r8 integer :: num_i @@ -175,7 +175,7 @@ contains integer :: mindist_index_p_arr(1) integer :: mindist_index_c_arr(1) - character(len=*), parameter :: subname = 'setup_and_run_glcmec' + character(len=*), parameter :: subname = 'setup_and_run_glc' !----------------------------------------------------------------------- ! Note that we assume the same number of patches as columns (i.e., one patch per @@ -187,7 +187,7 @@ contains @assertEqual(num_i, size(ltype_diff_i)) end if - call setup_landunit_ncols(ltype=ltype_glcmec, & + call setup_landunit_ncols(ltype=ltype_glc, & ctypes=[ctype_o], & cweights=[1._r8], & ptype=ptype_o) @@ -198,7 +198,7 @@ contains beg = bounds%begc, & name = 'column', & ctype = [ctype_o], & - ltype = [ltype_glcmec], & + ltype = [ltype_glc], & lat = [my_lat], & lon = [my_lon], & topoglc = [topoglc_o]) @@ -209,7 +209,7 @@ contains name = 'pft', & ptype = [ptype_o], & ctype = [ctype_o], & - ltype = [ltype_glcmec], & + ltype = [ltype_glc], & lat = [my_lat], & lon = [my_lon], & topoglc = [topoglc_o]) @@ -218,9 +218,9 @@ contains allocate(lat_i(num_i)) allocate(lon_i(num_i)) if (present(ltype_diff_i)) then - ltype_i(:) = ltype_glcmec + ltype_diff_i(:) + ltype_i(:) = ltype_glc + ltype_diff_i(:) else - ltype_i(:) = ltype_glcmec + ltype_i(:) = ltype_glc end if lat_i(:) = my_lat lon_i(:) = my_lon @@ -255,7 +255,7 @@ contains mindist_index_c = mindist_index_c_arr(1) mindist_index_p = mindist_index_p_arr(1) - end subroutine setup_and_run_glcmec + end subroutine setup_and_run_glc ! ======================================================================== @@ -309,7 +309,7 @@ contains end subroutine multipleTypes_findsSameType @Test - subroutine glcmec_elevclassesSame_findsSameColType(this) + subroutine glc_elevclassesSame_findsSameColType(this) ! When glc elevation classes are the same between input and output: Choose ! column/patch from the same column type, even if it isn't the one with the closest ! topographic height. @@ -326,7 +326,7 @@ contains ! - all input ptypes are the same as output ptype ! - all input ctypes are different, with one of them matching the output ctype ! - the matching input ctype has the most different topographic height - call setup_and_run_glcmec( & + call setup_and_run_glc( & ptype_o = my_ptype, & ctype_o = my_ctype, & topoglc_o = my_topo, & @@ -340,10 +340,10 @@ contains @assertEqual(3, mindist_index_c) @assertEqual(3, mindist_index_p) - end subroutine glcmec_elevclassesSame_findsSameColType + end subroutine glc_elevclassesSame_findsSameColType @Test - subroutine glcmec_elevclassesSame_findsSamePatchType(this) + subroutine glc_elevclassesSame_findsSamePatchType(this) ! When glc elevation classes are the same between input and output: Choose patch from ! the same patch type, even if it isn't the one with the closest topographic height. ! @@ -360,7 +360,7 @@ contains ! - all input ctypes are the same as output ctype (this probably shouldn't happen in ! practice, but is useful for testing the code logic) ! - the matching input ptype has the most different topographic height - call setup_and_run_glcmec( & + call setup_and_run_glc( & ptype_o = my_ptype, & ctype_o = my_ctype, & topoglc_o = my_topo, & @@ -378,12 +378,12 @@ contains ! the same type to arise in practice, so we haven't defined the behavior of this ! case.) @assertEqual(3, mindist_index_p) - end subroutine glcmec_elevclassesSame_findsSamePatchType + end subroutine glc_elevclassesSame_findsSamePatchType @Test - subroutine glcmec_elevclassesDiffer_findsClosestHeight(this) + subroutine glc_elevclassesDiffer_findsClosestHeight(this) ! When glc elevation classes differ between input and output: Ignore column and pft - ! types; if there are multiple glc_mec points that are equidistant in space, pick the + ! types; if there are multiple glacier points that are equidistant in space, pick the ! one with the closest height ! ! This tests both column-level and patch-level @@ -397,7 +397,7 @@ contains ! Note that we use different ptype and ctype values for the target point: these should ! be ignored in this case. However, ltype should *not* be ignored (and thus we should ! *not* pick the third point). - call setup_and_run_glcmec( & + call setup_and_run_glc( & ptype_o = my_ptype, & ctype_o = my_ctype, & topoglc_o = my_topo, & @@ -412,12 +412,12 @@ contains @assertEqual(2, mindist_index_c) @assertEqual(2, mindist_index_p) - end subroutine glcmec_elevclassesDiffer_findsClosestHeight + end subroutine glc_elevclassesDiffer_findsClosestHeight @Test - subroutine glcmec_collapseToAtmTopo_findsClosestHeight(this) - ! For an output glcmec point with the collapse_to_atm_topo behavior: Ignore column and - ! pft types; if there are multiple glc_mec points that are equidistant in space, pick + subroutine glc_collapseToAtmTopo_findsClosestHeight(this) + ! For an output glc point with the collapse_to_atm_topo behavior: Ignore column and + ! pft types; if there are multiple glacier points that are equidistant in space, pick ! the one with the closest height ! ! This tests both column-level and patch-level @@ -431,7 +431,7 @@ contains ! Note that we use different ptype and ctype values for the target point: these should ! be ignored in this case. However, ltype should *not* be ignored (and thus we should ! *not* pick the third point). - call setup_and_run_glcmec( & + call setup_and_run_glc( & ptype_o = my_ptype, & ctype_o = my_ctype, & topoglc_o = my_topo, & @@ -446,18 +446,18 @@ contains @assertEqual(2, mindist_index_c) @assertEqual(2, mindist_index_p) - end subroutine glcmec_collapseToAtmTopo_findsClosestHeight + end subroutine glc_collapseToAtmTopo_findsClosestHeight @Test - subroutine glcmec_elevclassesDiffer_findsClosestLatlon(this) - ! For glc_mec, if we have some points closer in topographic height, but others closer + subroutine glc_elevclassesDiffer_findsClosestLatlon(this) + ! For glacier, if we have some points closer in topographic height, but others closer ! in x-y space, pick the closer point in x-y space class(TestSetMindist), intent(inout) :: this type(subgrid_type) :: subgridi, subgrido type(glc_behavior_type) :: glc_behavior integer, parameter :: my_ctype = 15 - integer, parameter :: my_ltype = subgrid_special_indices%ilun_landice_multiple_elevation_classes + integer, parameter :: my_ltype = subgrid_special_indices%ilun_landice real(r8), parameter :: my_lat = 31._r8 real(r8), parameter :: my_lon = 41._r8 real(r8), parameter :: my_topo = 1000._r8 @@ -495,7 +495,7 @@ contains glc_behavior = glc_behavior, glc_elevclasses_same = .false.) @assertEqual(2, mindist_index(1)) - end subroutine glcmec_elevclassesDiffer_findsClosestLatlon + end subroutine glc_elevclassesDiffer_findsClosestLatlon @Test subroutine noncropToCrop_patchVariable_usesCorrectPft(this) diff --git a/src/main/ColumnType.F90 b/src/main/ColumnType.F90 index 181be48a0e..12e4a8c205 100644 --- a/src/main/ColumnType.F90 +++ b/src/main/ColumnType.F90 @@ -9,7 +9,7 @@ module ColumnType ! 1 => (istsoil) soil (vegetated or bare soil) ! 2 => (istcrop) crop (only for crop configuration) ! 3 => (UNUSED) (formerly non-multiple elevation class land ice; currently unused) - ! 4 => (istice_mec) land ice (multiple elevation classes) + ! 4 => (istice) land ice ! 5 => (istdlak) deep lake ! 6 => (istwet) wetland ! 71 => (icol_roof) urban roof diff --git a/src/main/LandunitType.F90 b/src/main/LandunitType.F90 index 2236ca2780..22770d2334 100644 --- a/src/main/LandunitType.F90 +++ b/src/main/LandunitType.F90 @@ -9,7 +9,7 @@ module LandunitType ! 1 => (istsoil) soil (vegetated or bare soil landunit) ! 2 => (istcrop) crop (only for crop configuration) ! 3 => (UNUSED) (formerly non-multiple elevation class land ice; currently unused) - ! 4 => (istice_mec) land ice (multiple elevation classes) + ! 4 => (istice) land ice ! 5 => (istdlak) deep lake ! 6 => (istwet) wetland ! 7 => (isturb_tbd) urban tbd @@ -41,7 +41,7 @@ module LandunitType 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 :: glcpoi (:) ! true=>glacier point logical , pointer :: active (:) ! true=>do computations on this landunit ! urban properties @@ -89,7 +89,7 @@ subroutine Init(this, begl, endl) 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. + allocate(this%glcpoi (begl:endl)); this%glcpoi (:) = .false. ! The following is initialized in routine setActive in module reweightMod allocate(this%active (begl:endl)) @@ -126,7 +126,7 @@ subroutine Clean(this) deallocate(this%ifspecial ) deallocate(this%lakpoi ) deallocate(this%urbpoi ) - deallocate(this%glcmecpoi ) + deallocate(this%glcpoi ) deallocate(this%active ) deallocate(this%canyon_hwr ) deallocate(this%wtroad_perv ) diff --git a/src/main/TopoMod.F90 b/src/main/TopoMod.F90 index 43b935bed0..e14762cc21 100644 --- a/src/main/TopoMod.F90 +++ b/src/main/TopoMod.F90 @@ -13,7 +13,7 @@ module TopoMod use LandunitType , only : lun use glc2lndMod , only : glc2lnd_type use glcBehaviorMod , only : glc_behavior_type - use landunit_varcon, only : istice_mec + use landunit_varcon, only : istice use filterColMod , only : filter_col_type, col_filter_from_logical_array_active_only ! ! !PUBLIC TYPES: @@ -112,7 +112,7 @@ end subroutine InitHistory !----------------------------------------------------------------------- subroutine InitCold(this, bounds) ! !USES: - use column_varcon , only: col_itype_to_icemec_class + use column_varcon , only: col_itype_to_ice_class use clm_instur, only : topo_glc_mec ! !ARGUMENTS: class(topo_type), intent(inout) :: this @@ -120,7 +120,7 @@ subroutine InitCold(this, bounds) ! ! !LOCAL VARIABLES: integer :: c, l, g - integer :: icemec_class ! current icemec class (1..maxpatch_glcmec) + integer :: ice_class ! current ice class (1..maxpatch_glc) character(len=*), parameter :: subname = 'InitCold' !----------------------------------------------------------------------- @@ -129,11 +129,11 @@ subroutine InitCold(this, bounds) l = col%landunit(c) g = col%gridcell(c) - if (lun%itype(l) == istice_mec) then - ! For ice_mec landunits, initialize topo_col based on surface dataset; this + if (lun%itype(l) == istice) then + ! For ice landunits, initialize topo_col based on surface dataset; this ! will get overwritten in the run loop by values sent from CISM - icemec_class = col_itype_to_icemec_class(col%itype(c)) - this%topo_col(c) = topo_glc_mec(g, icemec_class) + ice_class = col_itype_to_ice_class(col%itype(c)) + this%topo_col(c) = topo_glc_mec(g, ice_class) this%needs_downscaling_col(c) = .true. else ! For other landunits, arbitrarily initialize topo_col to 0 m; for landunits @@ -196,7 +196,7 @@ end subroutine Restart !----------------------------------------------------------------------- - subroutine UpdateTopo(this, bounds, num_icemecc, filter_icemecc, & + subroutine UpdateTopo(this, bounds, num_icec, filter_icec, & glc2lnd_inst, glc_behavior, atm_topo) ! ! !DESCRIPTION: @@ -210,8 +210,8 @@ subroutine UpdateTopo(this, bounds, num_icemecc, filter_icemecc, & ! !ARGUMENTS: class(topo_type) , intent(inout) :: this type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_icemecc ! number of points in filter_icemecc - integer , intent(in) :: filter_icemecc(:) ! col filter for ice_mec + integer , intent(in) :: num_icec ! number of points in filter_icec + integer , intent(in) :: filter_icec(:) ! col filter for ice type(glc2lnd_type) , intent(in) :: glc2lnd_inst type(glc_behavior_type) , intent(in) :: glc_behavior real(r8) , intent(in) :: atm_topo( bounds%begg: ) ! atmosphere topographic height [m] @@ -231,7 +231,7 @@ subroutine UpdateTopo(this, bounds, num_icemecc, filter_icemecc, & ! than trying to figure out where it does and does not need to be reset. this%needs_downscaling_col(begc:endc) = .false. - call glc_behavior%icemec_cols_need_downscaling(bounds, num_icemecc, filter_icemecc, & + call glc_behavior%ice_cols_need_downscaling(bounds, num_icec, filter_icec, & this%needs_downscaling_col(begc:endc)) ! In addition to updating topo_col, this also sets some additional elements of @@ -268,7 +268,7 @@ function DownscaleFilterc(this, bounds) result(filter) ! ! The main reason it's important to have this filter (as opposed to just doing the ! downscaling for all columns) is because of downscaled fields that are normalized - ! (like longwave radiation): Consider a gridcell with a glc_mec column and a + ! (like longwave radiation): Consider a gridcell with a glacier column and a ! vegetated column (outside of the icemask, so the vegetated column doesn't have its ! topographic height explicitly set). If we called the downscaling code for all ! columns, the longwave radiation would get adjusted over the vegetated column. This diff --git a/src/main/atm2lndMod.F90 b/src/main/atm2lndMod.F90 index cf81c2089a..71b8afeb63 100644 --- a/src/main/atm2lndMod.F90 +++ b/src/main/atm2lndMod.F90 @@ -21,7 +21,7 @@ module atm2lndMod use filterColMod , only : filter_col_type use LandunitType , only : lun use ColumnType , only : col - use landunit_varcon, only : istice_mec + use landunit_varcon, only : istice use WaterType , only : water_type use Wateratm2lndBulkType, only : wateratm2lndbulk_type ! @@ -343,7 +343,7 @@ subroutine partition_precip(bounds, atm2lnd_inst, wateratm2lndbulk_inst, eflx_sh l = col%landunit(c) rain_orig = forc_rain_c(c) snow_orig = forc_snow_c(c) - if (lun%itype(l) == istice_mec) then + if (lun%itype(l) == istice) then all_snow_t = atm2lnd_inst%params%precip_repartition_glc_all_snow_t frac_rain_slope = atm2lnd_inst%params%precip_repartition_glc_frac_rain_slope else @@ -524,7 +524,7 @@ subroutine downscale_longwave(bounds, downscale_filter_c, & ! 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 + ! downscaling (e.g., glacier 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) diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 400aa65f56..e84e9daf90 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -26,7 +26,7 @@ module clm_driver use abortutils , only : endrun ! use dynSubgridDriverMod , only : dynSubgrid_driver, dynSubgrid_wrapup_weight_changes - use BalanceCheckMod , only : BeginWaterBalance, BalanceCheck + use BalanceCheckMod , only : WaterGridcellBalance, BeginWaterColumnBalance, BalanceCheck ! use BiogeophysPreFluxCalcsMod , only : BiogeophysPreFluxCalcs use SurfaceHumidityMod , only : CalculateSurfaceHumidity @@ -74,13 +74,11 @@ module clm_driver use DaylengthMod , only : UpdateDaylength use perf_mod ! - use clm_instMod , 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_instMod , only : soil_water_retention_curve use EDBGCDynMod , only : EDBGCDyn, EDBGCDynSummary use SoilMoistureStreamMod , only : PrescribedSoilMoistureInterp, PrescribedSoilMoistureAdvance ! @@ -327,6 +325,13 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro end if call t_stopf('begcnbal_grc') + call t_startf('begwbal') + call WaterGridcellBalance(bounds_clump, & + filter(nc)%num_nolakec, filter(nc)%nolakec, & + filter(nc)%num_lakec, filter(nc)%lakec, & + water_inst, lakestate_inst, & + use_aquifer_layer = use_aquifer_layer(), flag = 'begwb') + call t_stopf('begwbal') end do !$OMP END PARALLEL DO @@ -362,9 +367,9 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro ! 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 + ! terms, qflx_liq_dynbal, etc.). Grid cell-level balance + ! checks ensure that the grid cell-level water is conserved by considering + ! qflx_liq_dynbal and calling WaterGridcellBalance ! before the weight updates. ! ! For carbon & nitrogen: This needs to be done after dynSubgrid_driver, because the @@ -382,7 +387,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call t_stopf('prescribed_sm') endif call t_startf('begwbal') - call BeginWaterBalance(bounds_clump, & + call BeginWaterColumnBalance(bounds_clump, & filter(nc)%num_nolakec, filter(nc)%nolakec, & filter(nc)%num_lakec, filter(nc)%lakec, & water_inst, soilhydrology_inst, lakestate_inst, & @@ -468,7 +473,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro energyflux_inst) call topo_inst%UpdateTopo(bounds_clump, & - filter(nc)%num_icemecc, filter(nc)%icemecc, & + filter(nc)%num_icec, filter(nc)%icec, & glc2lnd_inst, glc_behavior, & atm_topo = atm2lnd_inst%forc_topo_grc(bounds_clump%begg:bounds_clump%endg)) @@ -615,6 +620,8 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro water_inst%wateratm2lndbulk_inst, water_inst%waterdiagnosticbulk_inst, & water_inst%waterstatebulk_inst) + call ozone_inst%CalcOzoneStress(bounds_clump, filter(nc)%num_exposedvegp, filter(nc)%exposedvegp) + ! TODO(wjs, 2019-10-02) I'd like to keep moving this down until it is below ! LakeFluxes... I'll probably leave it in place there. if (water_inst%DoConsistencyCheck()) then @@ -1112,20 +1119,8 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call water_inst%Summary(bounds_clump, & filter(nc)%num_soilp, filter(nc)%soilp, & - filter(nc)%num_allc, filter(nc)%allc) - - ! ============================================================================ - ! Check the energy and water balance - ! ============================================================================ - - call t_startf('balchk') - call BalanceCheck(bounds_clump, & filter(nc)%num_allc, filter(nc)%allc, & - atm2lnd_inst, solarabs_inst, water_inst%waterfluxbulk_inst, & - water_inst%waterstatebulk_inst, water_inst%waterdiagnosticbulk_inst, & - water_inst%waterbalancebulk_inst, water_inst%wateratm2lndbulk_inst, & - surfalb_inst, energyflux_inst, canopystate_inst) - call t_stopf('balchk') + filter(nc)%num_nolakec, filter(nc)%nolakec) ! ============================================================================ ! Check the carbon and nitrogen balance @@ -1280,6 +1275,30 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro !$OMP END PARALLEL DO call t_stopf('lnd2glc') + ! ========================================================================== + ! Check the energy and water balance + ! ========================================================================== + + call t_startf('balchk') + !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) + do nc = 1,nclumps + call get_clump_bounds(nc, bounds_clump) + call WaterGridcellBalance(bounds_clump, & + filter(nc)%num_nolakec, filter(nc)%nolakec, & + filter(nc)%num_lakec, filter(nc)%lakec, & + water_inst, lakestate_inst, & + use_aquifer_layer = use_aquifer_layer(), flag = 'endwb') + call BalanceCheck(bounds_clump, & + filter(nc)%num_allc, filter(nc)%allc, & + atm2lnd_inst, solarabs_inst, water_inst%waterfluxbulk_inst, & + water_inst%waterstatebulk_inst, water_inst%waterdiagnosticbulk_inst, & + water_inst%waterbalancebulk_inst, water_inst%wateratm2lndbulk_inst, & + water_inst%waterlnd2atmbulk_inst, surfalb_inst, energyflux_inst, & + canopystate_inst) + end do + !$OMP END PARALLEL DO + call t_stopf('balchk') + ! ============================================================================ ! Write global average diagnostics to standard output ! ============================================================================ diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index 648e252f5c..47b8b32775 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -2,76 +2,67 @@ 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, get_proc_clumps, get_clump_bounds - use abortutils , only : endrun - use clm_varctl , only : nsrest, nsrStartup, nsrContinue, nsrBranch - use clm_varctl , only : is_cold_start, is_interpolated_start - use clm_varctl , only : iulog - use clm_varctl , only : use_lch4, use_cn, use_cndv, use_c13, use_c14, use_fates - use clm_varctl , only : use_soil_moisture_streams - use clm_instur , only : wt_lunit, urban_valid, wt_nat_patch, wt_cft, fert_cft, irrig_method, wt_glc_mec, topo_glc_mec, haslake - use perf_mod , only : t_startf, t_stopf - use readParamsMod , only : readParameters - use ncdio_pio , only : file_desc_t - use GridcellType , only : grc ! instance - use LandunitType , only : lun ! instance - use ColumnType , only : col ! instance - use PatchType , only : patch ! instance - use reweightMod , only : reweight_wrapup - use filterMod , only : allocFilters, filter, filter_inactive_and_active - use dynSubgridControlMod, only: dynSubgridControl_init, get_reset_dynbal_baselines - use CLMFatesInterfaceMod, only : CLMFatesGlobals - use SelfTestDriver, only : self_test_driver + !----------------------------------------------------------------------- + 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, get_proc_clumps, get_clump_bounds + use abortutils , only : endrun + use clm_varctl , only : nsrest, nsrStartup, nsrContinue, nsrBranch + use clm_varctl , only : is_cold_start, is_interpolated_start + use clm_varctl , only : iulog + use clm_varctl , only : use_lch4, use_cn, use_cndv, use_c13, use_c14, use_fates + use clm_varctl , only : use_soil_moisture_streams + use clm_instur , only : wt_lunit, urban_valid, wt_nat_patch, wt_cft, fert_cft + use clm_instur , only : irrig_method, wt_glc_mec, topo_glc_mec, haslake + use perf_mod , only : t_startf, t_stopf + use readParamsMod , only : readParameters + use ncdio_pio , only : file_desc_t + use GridcellType , only : grc ! instance + use LandunitType , only : lun ! instance + use ColumnType , only : col ! instance + use PatchType , only : patch ! instance + use reweightMod , only : reweight_wrapup + use filterMod , only : allocFilters, filter, filter_inactive_and_active + use CLMFatesInterfaceMod , only : CLMFatesGlobals + use dynSubgridControlMod , only : dynSubgridControl_init, get_reset_dynbal_baselines + use SelfTestDriver , only : self_test_driver + use SoilMoistureStreamMod , only : PrescribedSoilMoistureInit use clm_instMod - use SoilMoistureStreamMod, only : PrescribedSoilMoistureInit - ! + ! implicit none private ! By default everything is private - ! public :: initialize1 ! Phase one initialization public :: initialize2 ! Phase two initialization - !----------------------------------------------------------------------- + integer :: actual_numcft ! numcft from sfc dataset + +!----------------------------------------------------------------------- contains +!----------------------------------------------------------------------- - !----------------------------------------------------------------------- - subroutine initialize1(dtime, gindex_ocn) + subroutine initialize1(dtime) ! ! !DESCRIPTION: ! CLM initialization first phase ! ! !USES: - use clm_varpar , only: clm_varpar_init, natpft_lb, natpft_ub, cft_lb, cft_ub, maxpatch_glcmec, nlevsoi - use clm_varcon , only: clm_varcon_init - use landunit_varcon , only: landunit_varcon_init, max_lunit - use clm_varctl , only: fsurdat, fatmlndfrc, noland, version - use pftconMod , only: pftcon - use decompInitMod , only: decompInit_lnd, decompInit_clumps, decompInit_glcp, decompInit_lnd3D - use decompInitMod , only: decompInit_ocn - use domainMod , only: domain_check, ldomain, domain_init - use surfrdMod , only: surfrd_get_globmask, surfrd_get_grid, surfrd_get_data, surfrd_get_num_patches - use controlMod , only: control_init, control_print, NLFilename - use ncdio_pio , only: ncd_pio_init - use initGridCellsMod , only: initGridCells - use ch4varcon , only: ch4conrd - use UrbanParamsType , only: UrbanInput, IsSimpleBuildTemp + use clm_varpar , only: clm_varpar_init + use clm_varcon , only: clm_varcon_init + use landunit_varcon , only: landunit_varcon_init + use clm_varctl , only: fsurdat, version + use surfrdMod , only: surfrd_get_num_patches + use controlMod , only: control_init, control_print, NLFilename + use ncdio_pio , only: ncd_pio_init + use initGridCellsMod , only: initGridCells + use UrbanParamsType , only: IsSimpleBuildTemp + use dynSubgridControlMod , only: dynSubgridControl_init ! ! !ARGUMENTS integer, intent(in) :: dtime ! model time step (seconds) - - ! COMPILER_BUG(wjs, 2020-02-20, intel18.0.3) Although gindex_ocn could be - ! intent(out), intel18.0.3 generates a runtime segmentation fault in runs that don't - ! have this argument present when this is declared intent(out). (It works fine on - ! intel 19.0.2 when declared as intent(out).) See also - ! https://github.com/ESCOMP/CTSM/issues/930. - integer, pointer, optional, intent(inout) :: gindex_ocn(:) ! If present, this will hold the decomposition of ocean points (which is needed for the nuopc interface); note that this variable is allocated here, and is assumed to start unallocated ! ! !LOCAL VARIABLES: integer :: ier ! error status @@ -84,16 +75,13 @@ subroutine initialize1(dtime, gindex_ocn) integer :: nclumps ! number of clumps on this processor integer :: nc ! clump index integer :: actual_maxsoil_patches ! value from surface dataset - integer :: actual_numcft ! numcft from sfc dataset 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) @@ -109,100 +97,140 @@ subroutine initialize1(dtime, gindex_ocn) call clm_varpar_init(actual_maxsoil_patches, actual_numcft) call clm_varcon_init( IsSimpleBuildTemp() ) call landunit_varcon_init() - if (masterproc) call control_print() - call dynSubgridControl_init(NLFilename) - ! ------------------------------------------------------------------------ - ! 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 + call t_stopf('clm_init1') - ! ------------------------------------------------------------------------ - ! Determine clm gridcell decomposition and processor bounds for gridcells - ! ------------------------------------------------------------------------ + end subroutine initialize1 - call decompInit_lnd(ni, nj, amask) - if (present(gindex_ocn)) then - call decompInit_ocn(ni, nj, amask, gindex_ocn=gindex_ocn) - end if - deallocate(amask) + !----------------------------------------------------------------------- + subroutine initialize2(ni,nj) + ! + ! !DESCRIPTION: + ! CLM initialization second phase + ! + ! !USES: + use clm_varcon , only : spval + use clm_varpar , only : natpft_lb, natpft_ub, cft_lb, cft_ub, maxpatch_glc + use clm_varpar , only : nlevsno + use clm_varctl , only : fsurdat + use clm_varctl , only : finidat, finidat_interp_source, finidat_interp_dest, fsurdat + use clm_varctl , only : use_century_decomp, use_cn, use_fates + use clm_varctl , only : use_crop, ndep_from_cpl, fates_spitfire_mode + use clm_varorb , only : eccen, mvelpp, lambm0, obliqr + use landunit_varcon , only : landunit_varcon_init, max_lunit + use pftconMod , only : pftcon + use decompInitMod , only : decompInit_clumps, decompInit_glcp + use domainMod , only : domain_check, ldomain, domain_init + use surfrdMod , only : surfrd_get_data + use controlMod , only : NLFilename + use initGridCellsMod , only : initGridCells + use ch4varcon , only : ch4conrd + use UrbanParamsType , only : UrbanInput, IsSimpleBuildTemp + use shr_orb_mod , only : shr_orb_decl + use seq_drydep_mod , only : n_drydep, drydep_method, DD_XLND + use accumulMod , only : print_accum_fields + use clm_time_manager , only : get_step_size_real, get_curr_calday + use clm_time_manager , only : get_curr_date, get_nstep, advance_timestep + use clm_time_manager , only : timemgr_init, timemgr_restart_io, timemgr_restart, is_restart + use CIsoAtmTimeseriesMod , only : C14_init_BombSpike, use_c14_bombspike, C13_init_TimeSeries, use_c13_timeseries + use DaylengthMod , only : InitDaylength + use dynSubgridDriverMod , only : dynSubgrid_init + use dynConsBiogeophysMod , only : dyn_hwcontent_set_baselines + use fileutils , only : getfil + use initInterpMod , only : initInterp + 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 LakeCon , only : LakeConInit + use SatellitePhenologyMod , only : SatellitePhenologyInit, readAnnualVegetation, interpMonthlyVeg + use SnowSnicarMod , only : SnowAge_init, SnowOptics_init + use lnd2atmMod , only : lnd2atm_minimal + use controlMod , only : NLFilename + use clm_instMod , only : clm_fates + use BalanceCheckMod , only : BalanceCheckInit + use CNSharedParamsMod , only : CNParamsSetSoilDepth + use NutrientCompetitionFactoryMod , only : create_nutrient_competition_method + use FATESFireFactoryMod , only : scalar_lightning + ! + ! !ARGUMENTS + integer, intent(in) :: ni, nj ! global grid sizes + ! + ! !LOCAL VARIABLES: + integer :: c,g,i,j,k,l,n,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] + 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 + integer :: nclumps ! number of clumps on this processor + integer :: nc ! clump index + logical :: lexist + logical :: reset_dynbal_baselines_all_columns + logical :: reset_dynbal_baselines_lake_columns + integer :: begg, endg + integer :: begp, endp + integer :: begc, endc + integer :: begl, endl + real(r8), pointer :: data2dptr(:,:) ! temp. pointers for slicing larger arrays + character(len=32) :: subname = 'initialize2' ! subroutine name + !----------------------------------------------------------------------- - if(use_soil_moisture_streams) call decompInit_lnd3D(ni, nj, nlevsoi) - ! *** 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 t_startf('clm_init2') + ! Get processor bounds 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 - call surfrd_get_grid(begg, endg, ldomain, fatmlndfrc) - if (masterproc) then - call domain_check(ldomain) - endif - ldomain%mask = 1 !!! TODO - is this needed? - ! Initialize glc behavior call glc_behavior%Init(begg, endg, NLFilename) ! Initialize urban model input (initialize urbinp data structure) ! This needs to be called BEFORE the call to surfrd_get_data since ! that will call surfrd_get_special which in turn calls check_urban - call UrbanInput(begg, endg, mode='initialize') ! Allocate surface grid dynamic memory (just gridcell bounds dependent) - allocate (wt_lunit (begg:endg, max_lunit )) allocate (urban_valid (begg:endg )) allocate (wt_nat_patch (begg:endg, natpft_lb:natpft_ub )) allocate (wt_cft (begg:endg, cft_lb:cft_ub )) allocate (fert_cft (begg:endg, cft_lb:cft_ub )) allocate (irrig_method (begg:endg, cft_lb:cft_ub )) - allocate (wt_glc_mec (begg:endg, maxpatch_glcmec)) - allocate (topo_glc_mec(begg:endg, maxpatch_glcmec)) + allocate (wt_glc_mec (begg:endg, maxpatch_glc )) + allocate (topo_glc_mec (begg:endg, maxpatch_glc )) allocate (haslake (begg:endg )) + ! 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, actual_numcft) - ! ------------------------------------------------------------------------ ! Ask Fates to evaluate its own dimensioning needs. ! This determines the total amount of space it requires in its largest ! dimension. We are currently calling that the "cohort" dimension, but ! it is really a utility dimension that captures the models largest ! size need. ! Sets: - ! fates_maxElementsPerPatch - ! fates_maxElementsPerSite (where a site is roughly equivalent to a column) - ! + ! fates_maxElementsPerPatch + ! fates_maxElementsPerSite (where a site is roughly equivalent to a column) ! (Note: fates_maxELementsPerSite is the critical variable used by CLM ! to allocate space) ! This also sets up various global constants in FATES @@ -210,21 +238,16 @@ subroutine initialize1(dtime, gindex_ocn) call CLMFatesGlobals() - ! ------------------------------------------------------------------------ ! Determine decomposition of subgrid scale landunits, columns, patches - ! ------------------------------------------------------------------------ - - call decompInit_clumps(ns, ni, nj, glc_behavior) + call decompInit_clumps(ni, nj, glc_behavior) ! *** 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) @@ -232,15 +255,12 @@ subroutine initialize1(dtime, gindex_ocn) ! Build hierarchy and topological info for derived types ! This is needed here for the following call to decompInit_glcp - call initGridCells(glc_behavior) ! Set global seg maps for gridcells, landlunits, columns and patches - - call decompInit_glcp(ns, ni, nj, glc_behavior) + call decompInit_glcp(ni, nj, glc_behavior) ! Set filters - call allocFilters() nclumps = get_proc_clumps() @@ -251,14 +271,9 @@ subroutine initialize1(dtime, gindex_ocn) end do !$OMP END PARALLEL DO - ! ------------------------------------------------------------------------ - ! 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 @@ -269,114 +284,19 @@ subroutine initialize1(dtime, gindex_ocn) ! 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, haslake) - call t_stopf('clm_init1') - - 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 - 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_fates - use clm_varctl , only : use_crop, ndep_from_cpl, fates_spitfire_mode - use clm_varorb , only : eccen, mvelpp, lambm0, obliqr - use clm_time_manager , only : get_step_size_real, get_curr_calday - use clm_time_manager , only : get_curr_date, get_nstep, advance_timestep - use clm_time_manager , only : timemgr_init, timemgr_restart_io, timemgr_restart, is_restart - use CIsoAtmTimeseriesMod , only : C14_init_BombSpike, use_c14_bombspike, C13_init_TimeSeries, use_c13_timeseries - use DaylengthMod , only : InitDaylength - use dynSubgridDriverMod , only : dynSubgrid_init - use dynConsBiogeophysMod , only : dyn_hwcontent_set_baselines - use fileutils , only : getfil - use initInterpMod , only : initInterp - 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 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 - use controlMod , only : NLFilename - use clm_instMod , only : clm_fates - use BalanceCheckMod , only : BalanceCheckInit - use FATESFireFactoryMod , only : scalar_lightning - ! - ! !ARGUMENTS - ! - ! !LOCAL VARIABLES: - integer :: c,i,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 - logical :: reset_dynbal_baselines_all_columns - logical :: reset_dynbal_baselines_lake_columns - 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 - ! ------------------------------------------------------------------------ - call clm_instReadNML( NLFilename ) allocate(nutrient_competition_method, & source=create_nutrient_competition_method(bounds_proc)) - call readParameters(nutrient_competition_method, photosyns_inst) - ! ------------------------------------------------------------------------ ! Initialize time manager - ! ------------------------------------------------------------------------ - if (nsrest == nsrStartup) then call timemgr_init() else @@ -387,28 +307,20 @@ subroutine initialize2( ) call timemgr_restart() end if - ! ------------------------------------------------------------------------ ! Initialize daylength from the previous time step (needed so prev_dayl can be set correctly) - ! ------------------------------------------------------------------------ - call t_startf('init_orbd') - calday = get_curr_calday() call shr_orb_decl( calday, eccen, mvelpp, lambm0, obliqr, declin, eccf ) - dtime = get_step_size_real() 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, obliquity=obliqr) ! Initialize Balance checking (after time-manager) call BalanceCheckInit() ! History file variables - if (use_cn) then call hist_addfld1d (fname='DAYL', units='s', & avgflag='A', long_name='daylength', & @@ -419,13 +331,9 @@ subroutine initialize2( ) 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 @@ -445,55 +353,40 @@ subroutine initialize2( ) 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 CNParamsSetSoilDepth() + ! Initialize SNICAR optical and aging parameters call SnowOptics_init( ) ! SNICAR optical parameters: call SnowAge_init( ) ! SNICAR aging parameters: + ! Print history field info to standard out 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 - ! ------------------------------------------------------------------------ - + ! 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, glc_behavior, crop_inst) call t_stopf('init_dyn_subgrid') - ! ------------------------------------------------------------------------ ! Initialize baseline water and energy states needed for dynamic subgrid operation - ! ! This will be overwritten by the restart file, but needs to be done for a cold start ! case. - ! ! BACKWARDS_COMPATIBILITY(wjs, 2019-03-05) dyn_hwcontent_set_baselines is called again ! later in initialization if reset_dynbal_baselines is set. I think we could just have ! a single call in that location (adding some logic to also do the call if we're doing ! a cold start) once we can assume that all finidat files have the necessary restart ! fields on them. But for now, having the extra call here handles the case where the ! relevant restart fields are missing from an old finidat file. - ! ------------------------------------------------------------------------ - !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) do nc = 1,nclumps call get_clump_bounds(nc, bounds_clump) call dyn_hwcontent_set_baselines(bounds_clump, & - filter_inactive_and_active(nc)%num_icemecc, & - filter_inactive_and_active(nc)%icemecc, & + filter_inactive_and_active(nc)%num_icec, & + filter_inactive_and_active(nc)%icec, & filter_inactive_and_active(nc)%num_lakec, & filter_inactive_and_active(nc)%lakec, & urbanparams_inst, soilstate_inst, lakestate_inst, water_inst, temperature_inst, & @@ -503,26 +396,20 @@ subroutine initialize2( ) end do !$OMP END PARALLEL DO - ! ------------------------------------------------------------------------ ! Initialize modules (after time-manager initialization in most cases) - ! ------------------------------------------------------------------------ - if (use_cn) then call bgc_vegetation_inst%Init2(bounds_proc, NLFilename) ! NOTE(wjs, 2016-02-23) Maybe the rest of the body of this conditional should also ! be moved into bgc_vegetation_inst%Init2 - if (n_drydep > 0 .and. drydep_method == DD_XLND) then ! Must do this also when drydeposition is used so that estimates of monthly ! differences in LAI can be computed call SatellitePhenologyInit(bounds_proc) end if - if ( use_c14 .and. use_c14_bombspike ) then call C14_init_BombSpike() end if - if ( use_c13 .and. use_c13_timeseries ) then call C13_init_TimeSeries() end if @@ -535,34 +422,22 @@ subroutine initialize2( ) call clm_fates%Init2(bounds_proc, NLFilename) end if end if - - if(use_soil_moisture_streams) then + if (use_soil_moisture_streams) then call PrescribedSoilMoistureInit(bounds_proc) endif - - - ! ------------------------------------------------------------------------ ! 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. is_interpolated_start = .false. reset_dynbal_baselines_lake_columns = .false. - if (nsrest == nsrStartup) then - if (finidat == ' ') then if (finidat_interp_source == ' ') then is_cold_start = .true. @@ -583,9 +458,7 @@ subroutine initialize2( ) call restFile_read(bounds_proc, fnamer, glc_behavior, & reset_dynbal_baselines_lake_columns = reset_dynbal_baselines_lake_columns) end if - else if ((nsrest == nsrContinue) .or. (nsrest == nsrBranch)) then - if (masterproc) then write(iulog,*)'Reading restart file ',trim(fnamer) end if @@ -593,12 +466,8 @@ subroutine initialize2( ) reset_dynbal_baselines_lake_columns = reset_dynbal_baselines_lake_columns) end if - ! ------------------------------------------------------------------------ ! If appropriate, create interpolated initial conditions - ! ------------------------------------------------------------------------ - if (nsrest == nsrStartup .and. finidat_interp_source /= ' ') then - is_interpolated_start = .true. ! Check that finidat is not cold start - abort if it is @@ -622,16 +491,11 @@ subroutine initialize2( ) ! Reset finidat to now be finidat_interp_dest ! (to be compatible with routines still using finidat) finidat = trim(finidat_interp_dest) - end if - ! ------------------------------------------------------------------------ ! If requested, reset dynbal baselines - ! ! This needs to happen after reading the restart file (including after reading the ! interpolated restart file, if applicable). - ! ------------------------------------------------------------------------ - reset_dynbal_baselines_all_columns = get_reset_dynbal_baselines() if (nsrest == nsrBranch) then if (reset_dynbal_baselines_all_columns) then @@ -665,8 +529,8 @@ subroutine initialize2( ) call get_clump_bounds(nc, bounds_clump) call dyn_hwcontent_set_baselines(bounds_clump, & - filter_inactive_and_active(nc)%num_icemecc, & - filter_inactive_and_active(nc)%icemecc, & + filter_inactive_and_active(nc)%num_icec, & + filter_inactive_and_active(nc)%icec, & filter_inactive_and_active(nc)%num_lakec, & filter_inactive_and_active(nc)%lakec, & urbanparams_inst, soilstate_inst, lakestate_inst, & @@ -676,10 +540,7 @@ subroutine initialize2( ) end do !$OMP END PARALLEL DO - ! ------------------------------------------------------------------------ ! Initialize nitrogen deposition - ! ------------------------------------------------------------------------ - if (use_cn) then call t_startf('init_ndep') if (.not. ndep_from_cpl) then @@ -689,34 +550,24 @@ subroutine initialize2( ) 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) call water_inst%initAccVars(bounds_proc) call energyflux_inst%initAccVars(bounds_proc) call canopystate_inst%initAccVars(bounds_proc) - call bgc_vegetation_inst%initAccVars(bounds_proc) - if (use_crop) then call crop_inst%initAccVars(bounds_proc) end if @@ -725,13 +576,9 @@ subroutine initialize2( ) call clm_fates%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 @@ -741,10 +588,7 @@ subroutine initialize2( ) 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, & @@ -752,10 +596,7 @@ subroutine initialize2( ) call t_stopf('init_map2gc') end if - !------------------------------------------------------------ ! Initialize sno export state to send to glc - !------------------------------------------------------------ - !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) do nc = 1,nclumps call get_clump_bounds(nc, bounds_clump) @@ -769,19 +610,12 @@ subroutine initialize2( ) end do !$OMP END PARALLEL DO - !------------------------------------------------------------ ! Deallocate wt_nat_patch - !------------------------------------------------------------ - ! wt_nat_patch was allocated in initialize1, but needed to be kept around through ! initialize2 for some consistency checking; now it can be deallocated - deallocate(wt_nat_patch) - ! -------------------------------------------------------------- ! Initialise the fates model state structure - ! -------------------------------------------------------------- - if ( use_fates .and. .not.is_restart() .and. finidat == ' ') then call clm_fates%init_coldstart(water_inst%waterstatebulk_inst, & water_inst%waterdiagnosticbulk_inst, canopystate_inst, & @@ -789,15 +623,10 @@ subroutine initialize2( ) end if ! 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 - + ! initialize2 because it is used to initialize other variables; now it can be deallocated deallocate(topo_glc_mec, fert_cft, irrig_method) - !------------------------------------------------------------ ! Write log output for end of initialization - !------------------------------------------------------------ - call t_startf('init_wlog') if (masterproc) then write(iulog,*) 'Successfully initialized the land model' @@ -815,8 +644,6 @@ subroutine initialize2( ) endif call t_stopf('init_wlog') - call t_stopf('clm_init2') - if (water_inst%DoConsistencyCheck()) then !$OMP PARALLEL DO PRIVATE (nc, bounds_clump) do nc = 1,nclumps @@ -826,6 +653,8 @@ subroutine initialize2( ) !$OMP END PARALLEL DO end if + call t_stopf('clm_init2') + end subroutine initialize2 end module clm_initializeMod diff --git a/src/main/clm_instMod.F90 b/src/main/clm_instMod.F90 index ae42966634..13e360fac7 100644 --- a/src/main/clm_instMod.F90 +++ b/src/main/clm_instMod.F90 @@ -11,7 +11,7 @@ module clm_instMod use clm_varctl , only : use_cn, use_c13, use_c14, use_lch4, use_cndv, use_fates use clm_varctl , only : use_century_decomp, use_crop, snow_cover_fraction_method, paramfile use clm_varcon , only : bdsno, c13ratio, c14ratio - use landunit_varcon , only : istice_mec, istsoil + use landunit_varcon , only : istice, istsoil use perf_mod , only : t_startf, t_stopf use controlMod , only : NLFilename use fileutils , only : getfil @@ -193,6 +193,7 @@ subroutine clm_instInit(bounds) use SoilBiogeochemCompetitionMod , only : SoilBiogeochemCompetitionInit use initVerticalMod , only : initVertical + use SnowHydrologyMod , only : InitSnowLayers use accumulMod , only : print_accum_fields use SoilWaterRetentionCurveFactoryMod , only : create_soil_water_retention_curve use decompMod , only : get_proc_bounds @@ -241,7 +242,7 @@ subroutine clm_instInit(bounds) ! feedback may not activate on time (or at all). So, as a compromise, we start with ! a small amount of snow in places that are likely to be snow-covered for much or ! all of the year. - if (lun%itype(l)==istice_mec) then + if (lun%itype(l)==istice) then h2osno_col(c) = 100._r8 else if (lun%itype(l)==istsoil .and. abs(grc%latdeg(g)) >= 60._r8) then h2osno_col(c) = 100._r8 @@ -263,10 +264,15 @@ subroutine clm_instInit(bounds) call initVertical(bounds, & glc_behavior, & - snow_depth_col(begc:endc), & urbanparams_inst%thick_wall(begl:endl), & urbanparams_inst%thick_roof(begl:endl)) + !----------------------------------------------- + ! Set cold-start values for snow levels, snow layers and snow interfaces + !----------------------------------------------- + + call InitSnowLayers(bounds, snow_depth_col(bounds%begc:bounds%endc)) + ! Initialize clm->drv and drv->clm data structures call atm2lnd_inst%Init( bounds, NLFilename ) diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 45ae21ed89..796fa086fa 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -50,9 +50,6 @@ module clm_varctl ! by default this is not allowed logical, public :: brnch_retain_casename = .false. - !true => no valid land points -- do NOT run - logical, public :: noland = .false. - ! true => run tests of ncdio_pio logical, public :: for_testing_run_ncdiopio_tests = .false. @@ -92,13 +89,14 @@ module clm_varctl character(len=fname_len), public :: finidat = ' ' ! initial conditions file name character(len=fname_len), public :: fsurdat = ' ' ! surface data file name - character(len=fname_len), public :: fatmgrid = ' ' ! atm grid file name - character(len=fname_len), public :: fatmlndfrc = ' ' ! lnd frac file on atm grid character(len=fname_len), public :: paramfile = ' ' ! ASCII data file with PFT physiological constants character(len=fname_len), public :: nrevsn = ' ' ! restart data file name for branch run character(len=fname_len), public :: fsnowoptics = ' ' ! snow optical properties file name character(len=fname_len), public :: fsnowaging = ' ' ! snow aging parameters file name + character(len=fname_len), public :: fatmlndfrc = ' ' ! lnd frac file on atm grid + ! only needed for LILAC and MCT drivers + !---------------------------------------------------------- ! Flag to read ndep rather than obtain it from coupler !---------------------------------------------------------- diff --git a/src/main/clm_varpar.F90 b/src/main/clm_varpar.F90 index 7cadb20936..7594a2bf13 100644 --- a/src/main/clm_varpar.F90 +++ b/src/main/clm_varpar.F90 @@ -86,7 +86,7 @@ module clm_varpar integer, public :: cft_ub ! In arrays of PFTs, upper bound of PFTs on the crop landunit integer, public :: cft_size ! Number of PFTs on crop landunit in arrays of PFTs - integer, public :: maxpatch_glcmec ! max number of elevation classes + integer, public :: maxpatch_glc ! max number of elevation classes integer, public :: max_patch_per_col ! ! !PUBLIC MEMBER FUNCTIONS: diff --git a/src/main/column_varcon.F90 b/src/main/column_varcon.F90 index d57006859b..912e7ccee8 100644 --- a/src/main/column_varcon.F90 +++ b/src/main/column_varcon.F90 @@ -28,8 +28,8 @@ module column_varcon ! ! !PUBLIC MEMBER FUNCTIONS: public :: is_hydrologically_active ! returns true if the given column type is hydrologically active - public :: icemec_class_to_col_itype ! convert an icemec class (1..maxpatch_glcmec) into col%itype - public :: col_itype_to_icemec_class ! convert col%itype into an icemec class (1..maxpatch_glcmec) + public :: ice_class_to_col_itype ! convert an ice class (1..maxpatch_glc) into col%itype + public :: col_itype_to_ice_class ! convert col%itype into an ice class (1..maxpatch_glc) public :: write_coltype_metadata ! write column type metadata to a netcdf file character(len=*), parameter, private :: sourcefile = & @@ -77,56 +77,56 @@ end function is_hydrologically_active !----------------------------------------------------------------------- - function icemec_class_to_col_itype(icemec_class) result(col_itype) + function ice_class_to_col_itype(ice_class) result(col_itype) ! ! !DESCRIPTION: - ! Convert an icemec class (1..maxpatch_glcmec) into col%itype + ! Convert an ice class (1..maxpatch_glc) into col%itype ! ! !USES: - use clm_varpar, only : maxpatch_glcmec - use landunit_varcon, only : istice_mec + use clm_varpar, only : maxpatch_glc + use landunit_varcon, only : istice ! ! !ARGUMENTS: - integer :: col_itype ! function result - integer, intent(in) :: icemec_class ! icemec class, between 1 and maxpatch_glcmec + integer :: col_itype ! function result + integer, intent(in) :: ice_class ! ice class, between 1 and maxpatch_glc ! ! !LOCAL VARIABLES: - character(len=*), parameter :: subname = 'icemec_class_to_col_itype' + character(len=*), parameter :: subname = 'ice_class_to_col_itype' !----------------------------------------------------------------------- - SHR_ASSERT_FL((1 <= icemec_class .and. icemec_class <= maxpatch_glcmec), sourcefile, __LINE__) + SHR_ASSERT_FL((1 <= ice_class .and. ice_class <= maxpatch_glc), sourcefile, __LINE__) - col_itype = istice_mec*100 + icemec_class + col_itype = istice*100 + ice_class - end function icemec_class_to_col_itype + end function ice_class_to_col_itype !----------------------------------------------------------------------- - function col_itype_to_icemec_class(col_itype) result(icemec_class) + function col_itype_to_ice_class(col_itype) result(ice_class) ! ! !DESCRIPTION: - ! Convert a col%itype value (for an icemec landunit) into an icemec class (1..maxpatch_glcmec) + ! Convert a col%itype value (for an ice landunit) into an ice class (1..maxpatch_glc) ! ! !USES: - use clm_varpar, only : maxpatch_glcmec - use landunit_varcon, only : istice_mec + use clm_varpar, only : maxpatch_glc + use landunit_varcon, only : istice ! ! !ARGUMENTS: - integer :: icemec_class ! function result - integer, intent(in) :: col_itype ! col%itype value for an icemec landunit + integer :: ice_class ! function result + integer, intent(in) :: col_itype ! col%itype value for an ice landunit ! ! !LOCAL VARIABLES: - character(len=*), parameter :: subname = 'col_itype_to_icemec_class' + character(len=*), parameter :: subname = 'col_itype_to_ice_class' !----------------------------------------------------------------------- - icemec_class = col_itype - istice_mec*100 + ice_class = col_itype - istice*100 ! The following assertion is here to ensure that col_itype is really from an - ! istice_mec landunit - SHR_ASSERT_FL((1 <= icemec_class .and. icemec_class <= maxpatch_glcmec), sourcefile, __LINE__) + ! istice landunit + SHR_ASSERT_FL((1 <= ice_class .and. ice_class <= maxpatch_glc), sourcefile, __LINE__) - end function col_itype_to_icemec_class + end function col_itype_to_ice_class !----------------------------------------------------------------------- subroutine write_coltype_metadata(att_prefix, ncid) @@ -136,7 +136,7 @@ subroutine write_coltype_metadata(att_prefix, ncid) ! ! Note that, unlike pft and landunit metadata, this column type metadata is NOT ! stored in an array. This is because of the trickiness of encoding column values for - ! crop & icemec. So instead, other code must call this routine to do the work of + ! crop & ice. So instead, other code must call this routine to do the work of ! adding the appropriate metadata directly to a netcdf file. ! ! !USES: @@ -155,7 +155,7 @@ subroutine write_coltype_metadata(att_prefix, ncid) 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 // 'landice', '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) diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index ec22fff5c7..4bd7f3118c 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -19,7 +19,7 @@ module controlMod use spmdMod , only: MPI_CHARACTER, MPI_INTEGER, MPI_LOGICAL, MPI_REAL8 use decompMod , only: clump_pproc use clm_varcon , only: h2osno_max - use clm_varpar , only: maxpatch_glcmec, numrad, nlevsno + use clm_varpar , only: maxpatch_glc, numrad, nlevsno use fileutils , only: getavu, relavu, get_filename use histFileMod , only: max_tapes, max_namlen use histFileMod , only: hist_empty_htapes, hist_dov2xy, hist_avgflag_pertape, hist_type1d_pertape @@ -190,7 +190,7 @@ subroutine control_init(dtime) ! Glacier_mec info namelist /clm_inparm/ & - maxpatch_glcmec, glc_do_dynglacier, & + maxpatch_glc, glc_do_dynglacier, & glc_snow_persistence_max_days, & nlevsno, h2osno_max @@ -350,8 +350,8 @@ subroutine control_init(dtime) call apply_use_init_interp(finidat_interp_dest, finidat, finidat_interp_source) end if - if (maxpatch_glcmec <= 0) then - call endrun(msg=' ERROR: maxpatch_glcmec must be at least 1 ' // & + if (maxpatch_glc <= 0) then + call endrun(msg=' ERROR: maxpatch_glc must be at least 1 ' // & errMsg(sourcefile, __LINE__)) end if @@ -799,7 +799,7 @@ subroutine control_spmd() call mpi_bcast (h2osno_max, 1, MPI_REAL8, 0, mpicom, ier) ! glacier_mec variables - call mpi_bcast (maxpatch_glcmec, 1, MPI_INTEGER, 0, mpicom, ier) + call mpi_bcast (maxpatch_glc, 1, MPI_INTEGER, 0, mpicom, ier) call mpi_bcast (glc_do_dynglacier, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (glc_snow_persistence_max_days, 1, MPI_INTEGER, 0, mpicom, ier) @@ -971,7 +971,7 @@ subroutine control_print () write(iulog,*) ' Number of snow layers =', nlevsno write(iulog,*) ' Max snow depth (mm) =', h2osno_max - write(iulog,*) ' glc number of elevation classes =', maxpatch_glcmec + write(iulog,*) ' glc number of elevation classes =', maxpatch_glc if (glc_do_dynglacier) then write(iulog,*) ' glc CLM glacier areas and topography WILL evolve dynamically' else diff --git a/src/main/decompInitMod.F90 b/src/main/decompInitMod.F90 index c114e5968f..880d362cad 100644 --- a/src/main/decompInitMod.F90 +++ b/src/main/decompInitMod.F90 @@ -428,7 +428,7 @@ subroutine decompInit_ocn(ni, nj, amask, gindex_ocn) end subroutine decompInit_ocn !------------------------------------------------------------------------------ - subroutine decompInit_clumps(lns,lni,lnj,glc_behavior) + subroutine decompInit_clumps(lni,lnj,glc_behavior) ! ! !DESCRIPTION: ! This subroutine initializes the land surface decomposition into a clump @@ -441,7 +441,7 @@ subroutine decompInit_clumps(lns,lni,lnj,glc_behavior) ! ! !ARGUMENTS: implicit none - integer , intent(in) :: lns,lni,lnj ! land domain global size + integer , intent(in) :: lni,lnj ! land domain global size type(glc_behavior_type), intent(in) :: glc_behavior ! ! !LOCAL VARIABLES: @@ -590,7 +590,7 @@ subroutine decompInit_clumps(lns,lni,lnj,glc_behavior) end subroutine decompInit_clumps !------------------------------------------------------------------------------ - subroutine decompInit_glcp(lns,lni,lnj,glc_behavior) + subroutine decompInit_glcp(lni,lnj,glc_behavior) ! ! !DESCRIPTION: ! Determine gsMaps for landunits, columns, patches and cohorts @@ -602,7 +602,7 @@ subroutine decompInit_glcp(lns,lni,lnj,glc_behavior) ! ! !ARGUMENTS: implicit none - integer , intent(in) :: lns,lni,lnj ! land domain global size + integer , intent(in) :: lni,lnj ! land domain global size type(glc_behavior_type), intent(in) :: glc_behavior ! ! !LOCAL VARIABLES: diff --git a/src/main/filterMod.F90 b/src/main/filterMod.F90 index c87273cc97..98e4cc073d 100644 --- a/src/main/filterMod.F90 +++ b/src/main/filterMod.F90 @@ -87,8 +87,8 @@ module filterMod 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 :: icec(:) ! glacier filter (cols) + integer :: num_icec ! number of columns in glacier 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 @@ -227,7 +227,7 @@ subroutine allocFiltersOneGroup(this_filter) 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)%icec(bounds%endc-bounds%begc+1)) allocate(this_filter(nc)%do_smb_c(bounds%endc-bounds%begc+1)) end do @@ -289,7 +289,7 @@ subroutine setFiltersOneGroup(bounds, this_filter, include_inactive, glc_behavio ! !USES: use decompMod , only : BOUNDS_LEVEL_CLUMP use pftconMod , only : npcropmin - use landunit_varcon , only : istsoil, istcrop, istice_mec + use landunit_varcon , only : istsoil, istcrop, istice ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -488,13 +488,13 @@ subroutine setFiltersOneGroup(bounds, this_filter, include_inactive, glc_behavio 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 + if (lun%itype(l) == istice) then f = f + 1 - this_filter(nc)%icemecc(f) = c + this_filter(nc)%icec(f) = c end if end if end do - this_filter(nc)%num_icemecc = f + this_filter(nc)%num_icec = f f = 0 do c = bounds%begc,bounds%endc @@ -506,11 +506,11 @@ subroutine setFiltersOneGroup(bounds, this_filter, include_inactive, glc_behavio ! Elsewhere (where ice melt remains in place), we cannot compute a sensible ! negative SMB. ! - ! In addition to istice_mec columns, we also compute SMB for any soil column in + ! In addition to istice columns, we also compute SMB for any soil column in ! this region, in order to provide SMB forcing for the bare ground elevation ! class (elevation class 0). if ( glc_behavior%melt_replaced_by_ice_grc(g) .and. & - (lun%itype(l) == istice_mec .or. lun%itype(l) == istsoil)) then + (lun%itype(l) == istice .or. lun%itype(l) == istsoil)) then f = f + 1 this_filter(nc)%do_smb_c(f) = c end if diff --git a/src/main/glc2lndMod.F90 b/src/main/glc2lndMod.F90 index b23e40c333..5cbb5b9187 100644 --- a/src/main/glc2lndMod.F90 +++ b/src/main/glc2lndMod.F90 @@ -10,14 +10,14 @@ module glc2lndMod 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_varpar , only : maxpatch_glc use clm_varctl , only : iulog, glc_do_dynglacier use clm_varcon , only : nameg, spval, ispval use abortutils , only : endrun use GridcellType , only : grc use LandunitType , only : lun use ColumnType , only : col - use landunit_varcon, only : istice_mec + use landunit_varcon, only : istice use glcBehaviorMod , only : glc_behavior_type ! ! !REVISION HISTORY: @@ -144,9 +144,9 @@ subroutine InitAllocate(this, bounds) 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%frac_grc (begg:endg,0:maxpatch_glc)) ; this%frac_grc (:,:) = nan + allocate(this%topo_grc (begg:endg,0:maxpatch_glc)) ; this%topo_grc (:,:) = nan + allocate(this%hflx_grc (begg:endg,0:maxpatch_glc)) ; this%hflx_grc (:,:) = nan allocate(this%icemask_grc (begg:endg)) ; this%icemask_grc (:) = nan allocate(this%icemask_coupled_fluxes_grc (begg:endg)) ; this%icemask_coupled_fluxes_grc (:) = nan allocate(this%glc_dyn_runoff_routing_grc (begg:endg)) ; this%glc_dyn_runoff_routing_grc (:) = nan @@ -266,22 +266,22 @@ subroutine set_glc2lnd_fields_mct(this, bounds, glc_present, x2l, & ! ! !LOCAL VARIABLES: integer :: g - integer :: icemec_class + integer :: ice_class character(len=*), parameter :: subname = 'set_glc2lnd_fields_mct' !----------------------------------------------------------------------- SHR_ASSERT_FL((ubound(x2l, 2) == bounds%endg), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(index_x2l_Sg_ice_covered) == (/maxpatch_glcmec/)), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(index_x2l_Sg_topo) == (/maxpatch_glcmec/)), sourcefile, __LINE__) - SHR_ASSERT_ALL_FL((ubound(index_x2l_Flgg_hflx) == (/maxpatch_glcmec/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(index_x2l_Sg_ice_covered) == (/maxpatch_glc/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(index_x2l_Sg_topo) == (/maxpatch_glc/)), sourcefile, __LINE__) + SHR_ASSERT_ALL_FL((ubound(index_x2l_Flgg_hflx) == (/maxpatch_glc/)), sourcefile, __LINE__) if (glc_present) then do g = bounds%begg, bounds%endg - do icemec_class = 0, maxpatch_glcmec - this%frac_grc(g,icemec_class) = x2l(index_x2l_Sg_ice_covered(icemec_class),g) - this%topo_grc(g,icemec_class) = x2l(index_x2l_Sg_topo(icemec_class),g) - this%hflx_grc(g,icemec_class) = x2l(index_x2l_Flgg_hflx(icemec_class),g) + do ice_class = 0, maxpatch_glc + this%frac_grc(g,ice_class) = x2l(index_x2l_Sg_ice_covered(ice_class),g) + this%topo_grc(g,ice_class) = x2l(index_x2l_Sg_topo(ice_class),g) + this%hflx_grc(g,ice_class) = x2l(index_x2l_Flgg_hflx(ice_class),g) end do this%icemask_grc(g) = x2l(index_x2l_Sg_icemask,g) this%icemask_coupled_fluxes_grc(g) = x2l(index_x2l_Sg_icemask_coupled_fluxes,g) @@ -319,7 +319,7 @@ subroutine set_glc2lnd_fields_nuopc(this, bounds, glc_present, & ! ! !LOCAL VARIABLES: integer :: g - integer :: icemec_class + integer :: ice_class character(len=*), parameter :: subname = 'set_glc2lnd_fields_nuopc' !----------------------------------------------------------------------- @@ -332,10 +332,10 @@ subroutine set_glc2lnd_fields_nuopc(this, bounds, glc_present, & if (glc_present) then do g = bounds%begg, bounds%endg - do icemec_class = 0, maxpatch_glcmec - this%frac_grc(g,icemec_class) = frac_grc(g,icemec_class) - this%topo_grc(g,icemec_class) = topo_grc(g,icemec_class) - this%hflx_grc(g,icemec_class) = hflx_grc(g,icemec_class) + do ice_class = 0, maxpatch_glc + this%frac_grc(g,ice_class) = frac_grc(g,ice_class) + this%topo_grc(g,ice_class) = topo_grc(g,ice_class) + this%hflx_grc(g,ice_class) = hflx_grc(g,ice_class) end do this%icemask_grc(g) = icemask_grc(g) this%icemask_coupled_fluxes_grc(g) = icemask_coupled_fluxes_grc(g) @@ -384,8 +384,8 @@ subroutine for_test_set_glc2lnd_fields_directly(this, bounds, & !----------------------------------------------------------------------- if (present(topo)) then - SHR_ASSERT_ALL_FL((ubound(topo) == (/bounds%endg, maxpatch_glcmec/)), sourcefile, __LINE__) - this%topo_grc(bounds%begg:bounds%endg, 0:maxpatch_glcmec) = topo(bounds%begg:bounds%endg, 0:maxpatch_glcmec) + SHR_ASSERT_ALL_FL((ubound(topo) == (/bounds%endg, maxpatch_glc/)), sourcefile, __LINE__) + this%topo_grc(bounds%begg:bounds%endg, 0:maxpatch_glc) = topo(bounds%begg:bounds%endg, 0:maxpatch_glc) end if if (present(icemask)) then @@ -614,7 +614,7 @@ subroutine update_glc2lnd_fracs(this, bounds) ! If glc_do_dynglacier is false, nothing is changed ! ! !USES: - use column_varcon , only : col_itype_to_icemec_class + use column_varcon , only : col_itype_to_ice_class use subgridWeightsMod , only : set_landunit_weight ! ! !ARGUMENTS: @@ -623,10 +623,10 @@ subroutine update_glc2lnd_fracs(this, 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 + real(r8):: area_ice ! area of the ice landunit + integer :: l_ice ! index of the ice landunit + integer :: ice_class ! current ice class (1..maxpatch_glc) + logical :: frac_assigned(1:maxpatch_glc) ! whether this%frac has been assigned for each elevation class logical :: error ! if an error was found character(len=*), parameter :: subname = 'update_glc2lnd_fracs' @@ -637,46 +637,46 @@ subroutine update_glc2lnd_fracs(this, bounds) ! 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) + ! Set total ice landunit area + area_ice = sum(this%frac_grc(g, 1:maxpatch_glc)) + call set_landunit_weight(g, istice, area_ice) ! 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 + if (area_ice > 0) then + ! Determine index of the ice landunit + l_ice = grc%landunit_indices(istice, g) + if (l_ice == ispval) then + write(iulog,*) subname//' ERROR: no ice 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. + frac_assigned(1:maxpatch_glc) = .false. + do c = lun%coli(l_ice), lun%colf(l_ice) + ice_class = col_itype_to_ice_class(col%itype(c)) + col%wtlunit(c) = this%frac_grc(g, ice_class) / lun%wtgcell(l_ice) + frac_assigned(ice_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 + do ice_class = 1, maxpatch_glc + if (this%frac_grc(g, ice_class) > 0._r8 .and. & + .not. frac_assigned(ice_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,*) subname//' ERROR: at least one glc 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) + write(iulog,*) 'this%frac_grc(g, 1:maxpatch_glc) = ', & + this%frac_grc(g, 1:maxpatch_glc) + write(iulog,*) 'frac_assigned(1:maxpatch_glc) = ', & + frac_assigned(1:maxpatch_glc) call endrun() end if ! error - end if ! area_ice_mec > 0 + end if ! area_ice > 0 end if ! this%icemask_grc(g) > 0 end do ! g end if ! glc_do_dynglacier @@ -697,8 +697,8 @@ subroutine update_glc2lnd_topo(this, bounds, topo_col, needs_downscaling_col) ! needs_downscaling_col are left unchanged. ! ! !USES: - use landunit_varcon , only : istice_mec - use column_varcon , only : col_itype_to_icemec_class + use landunit_varcon , only : istice + use column_varcon , only : col_itype_to_ice_class ! ! !ARGUMENTS: class(glc2lnd_type) , intent(in) :: this @@ -708,7 +708,7 @@ subroutine update_glc2lnd_topo(this, bounds, topo_col, needs_downscaling_col) ! ! !LOCAL VARIABLES: integer :: c, l, g ! indices - integer :: icemec_class ! current icemec class (1..maxpatch_glcmec) + integer :: ice_class ! current ice class (1..maxpatch_glc) character(len=*), parameter :: subname = 'update_glc2lnd_topo' !----------------------------------------------------------------------- @@ -723,11 +723,11 @@ subroutine update_glc2lnd_topo(this, bounds, topo_col, needs_downscaling_col) ! 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)) + if (lun%itype(l) == istice) then + ice_class = col_itype_to_ice_class(col%itype(c)) else ! If not on a glaciated column, assign topography to the bare-land value determined by GLC. - icemec_class = 0 + ice_class = 0 end if ! Note that we do downscaling over all column types. This is for consistency: @@ -738,7 +738,7 @@ subroutine update_glc2lnd_topo(this, bounds, topo_col, needs_downscaling_col) ! this currently isn't allowed because the urban code references some ! non-downscaled, gridcell-level atmospheric forcings if (.not. lun%urbpoi(l)) then - topo_col(c) = this%topo_grc(g, icemec_class) + topo_col(c) = this%topo_grc(g, ice_class) needs_downscaling_col(c) = .true. end if end if diff --git a/src/main/glcBehaviorMod.F90 b/src/main/glcBehaviorMod.F90 index 2b7dc5ef63..f7d98f805e 100644 --- a/src/main/glcBehaviorMod.F90 +++ b/src/main/glcBehaviorMod.F90 @@ -11,7 +11,7 @@ module glcBehaviorMod use shr_log_mod , only : errMsg => shr_log_errMsg use abortutils , only : endrun use clm_varctl , only : iulog - use landunit_varcon, only : istice_mec + use landunit_varcon, only : istice use clm_instur , only : wt_lunit, wt_glc_mec use decompMod , only : bounds_type use filterColMod , only : filter_col_type @@ -31,7 +31,7 @@ module glcBehaviorMod ! ------------------------------------------------------------------------ ! If has_virtual_columns_grc(g) is true, then grid cell g has virtual columns for - ! all possible glc_mec columns. + ! all possible glacier columns. ! ! For the sake of coupling with CISM, this should only be needed within the icemask, ! where we need virtual columns for the sake of coupling with CISM. This is needed in @@ -87,7 +87,7 @@ module glcBehaviorMod ! Private data ! ------------------------------------------------------------------------ - ! If collapse_to_atm_topo_grc(g) is true, then grid cell g has at most one glc_mec + ! If collapse_to_atm_topo_grc(g) is true, then grid cell g has at most one glacier ! column, whose topographic height exactly matches the atmosphere's topographic ! height for that grid cell (so that there is no adjustment of atmospheric ! forcings). @@ -106,30 +106,30 @@ module glcBehaviorMod procedure, public :: InitFromInputs ! version of Init meant for unit testing (and called by other code in this class) procedure, public :: InitSetDirectly ! version of Init meant for unit testing - ! get number of subgrid units in glc_mec landunit on one grid cell - procedure, public :: get_num_glc_mec_subgrid + ! get number of subgrid units in glc landunit on one grid cell + procedure, public :: get_num_glc_subgrid - ! returns true if memory should be allocated for the given glc_mec column, and its + ! returns true if memory should be allocated for the given glc column, and its ! weight on the landunit - procedure, public :: glc_mec_col_exists + procedure, public :: glc_col_exists - ! returns true if glc_mec columns on the given grid cell have dynamic type (type + ! returns true if glc columns on the given grid cell have dynamic type (type ! potentially changing at runtime) procedure, public :: cols_have_dynamic_type - ! Sets a column-level logical array to true for any ice_mec column that needs - ! downscaling, false for any ice_mec column that does not need downscaling - procedure, public :: icemec_cols_need_downscaling + ! Sets a column-level logical array to true for any ice column that needs + ! downscaling, false for any ice column that does not need downscaling + procedure, public :: ice_cols_need_downscaling - ! Sets a column-level logical array to true for any ice_mec column that has - ! dynamic type, false for any ice_mec column that does not have dynamic type + ! Sets a column-level logical array to true for any ice column that has + ! dynamic type, false for any ice column that does not have dynamic type procedure, public :: cols_have_dynamic_type_array - ! Sets a patch-level logical array to true for any ice_mec column that has - ! dynamic type, false for any ice_mec column that does not have dynamic type + ! Sets a patch-level logical array to true for any ice column that has + ! dynamic type, false for any ice column that does not have dynamic type procedure, public :: patches_have_dynamic_type_array - ! update the column class types of any glc_mec columns that need to be updated + ! update the column class types of any glc columns that need to be updated procedure, public :: update_glc_classes ! ------------------------------------------------------------------------ @@ -151,11 +151,11 @@ module glcBehaviorMod ! reads local namelist items procedure, private, nopass :: read_namelist - ! returns a column-level filter of ice_mec columns with the collapse_to_atm_topo + ! returns a column-level filter of ice columns with the collapse_to_atm_topo ! behavior - procedure, private :: collapse_to_atm_topo_icemec_filterc + procedure, private :: collapse_to_atm_topo_ice_filterc - ! update class of glc_mec columns in regions where these are collapsed to a single + ! update class of glc columns in regions where these are collapsed to a single ! column, given a filter procedure, private :: update_collapsed_columns_classes @@ -659,13 +659,13 @@ end subroutine read_namelist !----------------------------------------------------------------------- - subroutine get_num_glc_mec_subgrid(this, gi, atm_topo, npatches, ncols, nlunits) + subroutine get_num_glc_subgrid(this, gi, atm_topo, npatches, ncols, nlunits) ! ! !DESCRIPTION: - ! Get number of subgrid units in glc_mec landunit on one grid cell + ! Get number of subgrid units in glc landunit on one grid cell ! ! !USES: - use clm_varpar , only : maxpatch_glcmec + use clm_varpar , only : maxpatch_glc ! ! !ARGUMENTS: class(glc_behavior_type), intent(in) :: this @@ -680,13 +680,13 @@ subroutine get_num_glc_mec_subgrid(this, gi, atm_topo, npatches, ncols, nlunits) logical :: col_exists real(r8) :: col_wt_lunit - character(len=*), parameter :: subname = 'get_num_glc_mec_subgrid' + character(len=*), parameter :: subname = 'get_num_glc_subgrid' !----------------------------------------------------------------------- ncols = 0 - do m = 1, maxpatch_glcmec - call this%glc_mec_col_exists(gi = gi, elev_class = m, atm_topo = atm_topo, & + do m = 1, maxpatch_glc + call this%glc_col_exists(gi = gi, elev_class = m, atm_topo = atm_topo, & exists = col_exists, col_wt_lunit = col_wt_lunit) if (col_exists) then ncols = ncols + 1 @@ -694,9 +694,9 @@ subroutine get_num_glc_mec_subgrid(this, gi, atm_topo, npatches, ncols, nlunits) end do if (this%collapse_to_atm_topo_grc(gi) .and. & - wt_lunit(gi, istice_mec) > 0.0_r8) then + wt_lunit(gi, istice) > 0.0_r8) then ! For grid cells with the collapse_to_atm_topo behavior, with a non-zero weight - ! ice_mec landunit, we expect exactly one column + ! ice landunit, we expect exactly one column SHR_ASSERT_FL(ncols == 1, sourcefile, __LINE__) end if @@ -708,15 +708,15 @@ subroutine get_num_glc_mec_subgrid(this, gi, atm_topo, npatches, ncols, nlunits) nlunits = 0 end if - end subroutine get_num_glc_mec_subgrid + end subroutine get_num_glc_subgrid !----------------------------------------------------------------------- - subroutine glc_mec_col_exists(this, gi, elev_class, atm_topo, exists, col_wt_lunit) + subroutine glc_col_exists(this, gi, elev_class, atm_topo, exists, col_wt_lunit) ! ! !DESCRIPTION: - ! For the given glc_mec column, with elevation class index elev_class, in grid cell + ! For the given glc column, with elevation class index elev_class, in grid cell ! gi: sets exists to true if memory should be allocated for this column, and sets - ! col_wt_lunit to the column's weight on the icemec landunit. + ! col_wt_lunit to the column's weight on the ice landunit. ! ! If exists is false, then col_wt_lunit is arbitrary and should be ignored. ! @@ -731,13 +731,13 @@ subroutine glc_mec_col_exists(this, gi, elev_class, atm_topo, exists, col_wt_lun integer, intent(in) :: elev_class ! elevation class index real(r8), intent(in) :: atm_topo ! atmosphere's topographic height for this grid cell (m) logical, intent(out) :: exists ! whether memory should be allocated for this column - real(r8), intent(out) :: col_wt_lunit ! column's weight on the icemec landunit + real(r8), intent(out) :: col_wt_lunit ! column's weight on the ice landunit ! ! !LOCAL VARIABLES: integer :: atm_elev_class ! elevation class corresponding to atmosphere topographic height integer :: err_code - character(len=*), parameter :: subname = 'glc_mec_col_exists' + character(len=*), parameter :: subname = 'glc_col_exists' !----------------------------------------------------------------------- ! Set default outputs @@ -745,7 +745,7 @@ subroutine glc_mec_col_exists(this, gi, elev_class, atm_topo, exists, col_wt_lun col_wt_lunit = wt_glc_mec(gi, elev_class) if (this%collapse_to_atm_topo_grc(gi)) then - if (wt_lunit(gi, istice_mec) > 0.0_r8) then + if (wt_lunit(gi, istice) > 0.0_r8) then call glc_get_elevation_class(atm_topo, atm_elev_class, err_code) if ( err_code == GLC_ELEVCLASS_ERR_NONE .or. & err_code == GLC_ELEVCLASS_ERR_TOO_LOW .or. & @@ -773,7 +773,7 @@ subroutine glc_mec_col_exists(this, gi, elev_class, atm_topo, exists, col_wt_lun else ! collapse_to_atm_topo_grc .false. if (this%has_virtual_columns_grc(gi)) then exists = .true. - else if (wt_lunit(gi, istice_mec) > 0.0_r8 .and. & + else if (wt_lunit(gi, istice) > 0.0_r8 .and. & wt_glc_mec(gi, elev_class) > 0.0_r8) then ! If the landunit has non-zero weight on the grid cell, and this column has ! non-zero weight on the landunit... @@ -781,13 +781,13 @@ subroutine glc_mec_col_exists(this, gi, elev_class, atm_topo, exists, col_wt_lun end if end if - end subroutine glc_mec_col_exists + end subroutine glc_col_exists !----------------------------------------------------------------------- function cols_have_dynamic_type(this, gi) ! ! !DESCRIPTION: - ! Returns true if glc_mec columns on the given grid cell have dynamic type (i.e., + ! Returns true if glc columns on the given grid cell have dynamic type (i.e., ! type potentially changing at runtime) ! ! !USES: @@ -811,22 +811,22 @@ function cols_have_dynamic_type(this, gi) end function cols_have_dynamic_type !----------------------------------------------------------------------- - subroutine icemec_cols_need_downscaling(this, bounds, num_icemecc, filter_icemecc, & + subroutine ice_cols_need_downscaling(this, bounds, num_icec, filter_icec, & needs_downscaling_col) ! ! !DESCRIPTION: - ! Sets needs_downscaling_col to true for any ice_mec column that needs downscaling, - ! false for any ice_mec column that does not need downscaling. + ! Sets needs_downscaling_col to true for any ice column that needs downscaling, + ! false for any ice column that does not need downscaling. ! - ! Outside of filter_icemecc, leaves needs_downscaling_col untouched. + ! Outside of filter_icec, leaves needs_downscaling_col untouched. ! ! !USES: ! ! !ARGUMENTS: class(glc_behavior_type) , intent(in) :: this type(bounds_type) , intent(in) :: bounds - integer , intent(in) :: num_icemecc ! number of points in filter_icemecc - integer , intent(in) :: filter_icemecc(:) ! col filter for ice_mec + integer , intent(in) :: num_icec ! number of points in filter_icec + integer , intent(in) :: filter_icec(:) ! col filter for ice logical , intent(inout) :: needs_downscaling_col( bounds%begc: ) ! ! !LOCAL VARIABLES: @@ -834,13 +834,13 @@ subroutine icemec_cols_need_downscaling(this, bounds, num_icemecc, filter_icemec integer :: c integer :: g - character(len=*), parameter :: subname = 'icemec_cols_need_downscaling' + character(len=*), parameter :: subname = 'ice_cols_need_downscaling' !----------------------------------------------------------------------- SHR_ASSERT_ALL_FL((ubound(needs_downscaling_col) == (/bounds%endc/)), sourcefile, __LINE__) - do fc = 1, num_icemecc - c = filter_icemecc(fc) + do fc = 1, num_icec + c = filter_icec(fc) g = col%gridcell(c) if (this%collapse_to_atm_topo_grc(g)) then @@ -850,16 +850,16 @@ subroutine icemec_cols_need_downscaling(this, bounds, num_icemecc, filter_icemec end if end do - end subroutine icemec_cols_need_downscaling + end subroutine ice_cols_need_downscaling !----------------------------------------------------------------------- subroutine cols_have_dynamic_type_array(this, begc, endc, has_dynamic_type_col) ! ! !DESCRIPTION: - ! Sets a column-level logical array to true for any ice_mec column that has - ! dynamic type, false for any ice_mec column that does not have dynamic type. + ! Sets a column-level logical array to true for any ice column that has + ! dynamic type, false for any ice column that does not have dynamic type. ! - ! The value is undefined for non-ice_mec columns. + ! The value is undefined for non-ice columns. ! ! !ARGUMENTS: class(glc_behavior_type) , intent(in) :: this @@ -878,7 +878,7 @@ subroutine cols_have_dynamic_type_array(this, begc, endc, has_dynamic_type_col) do c = begc, endc g = col%gridcell(c) - ! Users shouldn't rely on the values set for non-ice_mec columns, but it's simpler + ! Users shouldn't rely on the values set for non-ice columns, but it's simpler ! just to set this for all column types. if (this%collapse_to_atm_topo_grc(g)) then has_dynamic_type_col(c) = .true. @@ -893,10 +893,10 @@ end subroutine cols_have_dynamic_type_array subroutine patches_have_dynamic_type_array(this, begp, endp, has_dynamic_type_patch) ! ! !DESCRIPTION: - ! Sets a patch-level logical array to true for any ice_mec patch that has - ! dynamic type, false for any ice_mec patch that does not have dynamic type. + ! Sets a patch-level logical array to true for any ice patch that has + ! dynamic type, false for any ice patch that does not have dynamic type. ! - ! The value is undefined for non-ice_mec patches. + ! The value is undefined for non-ice patches. ! ! !ARGUMENTS: class(glc_behavior_type) , intent(in) :: this @@ -915,7 +915,7 @@ subroutine patches_have_dynamic_type_array(this, begp, endp, has_dynamic_type_pa do p = begp, endp g = patch%gridcell(p) - ! Users shouldn't rely on the values set for non-ice_mec patches, but it's simpler + ! Users shouldn't rely on the values set for non-ice patches, but it's simpler ! just to set this for all patch types. if (this%collapse_to_atm_topo_grc(g)) then has_dynamic_type_patch(p) = .true. @@ -930,7 +930,7 @@ end subroutine patches_have_dynamic_type_array subroutine update_glc_classes(this, bounds, topo_col) ! ! !DESCRIPTION: - ! Update the column class types of any glc_mec columns that need to be updated. + ! Update the column class types of any glc columns that need to be updated. ! ! Assumes that topo_col has already been set appropriately. ! @@ -947,7 +947,7 @@ subroutine update_glc_classes(this, bounds, topo_col) character(len=*), parameter :: subname = 'update_glc_classes' !----------------------------------------------------------------------- - collapse_filterc = this%collapse_to_atm_topo_icemec_filterc(bounds) + collapse_filterc = this%collapse_to_atm_topo_ice_filterc(bounds) call this%update_collapsed_columns_classes(bounds, collapse_filterc, topo_col) end subroutine update_glc_classes @@ -956,7 +956,7 @@ end subroutine update_glc_classes subroutine update_collapsed_columns_classes(this, bounds, collapse_filterc, topo_col) ! ! !DESCRIPTION: - ! Update class of glc_mec columns in regions where these are collapsed to a single + ! Update class of glc columns in regions where these are collapsed to a single ! column, given a filter. ! ! Assumes that topo_col has already been updated appropriately for these columns. @@ -965,7 +965,7 @@ subroutine update_collapsed_columns_classes(this, bounds, collapse_filterc, topo use glc_elevclass_mod, only : glc_get_elevation_class, GLC_ELEVCLASS_ERR_NONE use glc_elevclass_mod, only : GLC_ELEVCLASS_ERR_TOO_LOW, GLC_ELEVCLASS_ERR_TOO_HIGH use glc_elevclass_mod, only : glc_errcode_to_string - use column_varcon , only : icemec_class_to_col_itype + use column_varcon , only : ice_class_to_col_itype ! ! !ARGUMENTS: class(glc_behavior_type), intent(in) :: this @@ -976,7 +976,7 @@ subroutine update_collapsed_columns_classes(this, bounds, collapse_filterc, topo ! !LOCAL VARIABLES: integer :: fc ! filter index integer :: c ! column index - integer :: elev_class ! elevation class of the single column on the ice_mec landunit + integer :: elev_class ! elevation class of the single column on the ice landunit integer :: err_code integer :: new_coltype @@ -1004,7 +1004,7 @@ subroutine update_collapsed_columns_classes(this, bounds, collapse_filterc, topo call endrun(msg=subname//': ERROR getting elevation class') end if - new_coltype = icemec_class_to_col_itype(elev_class) + new_coltype = ice_class_to_col_itype(elev_class) if (new_coltype /= col%itype(c)) then call col%update_itype(c = c, itype = new_coltype) end if @@ -1013,10 +1013,10 @@ subroutine update_collapsed_columns_classes(this, bounds, collapse_filterc, topo end subroutine update_collapsed_columns_classes !----------------------------------------------------------------------- - function collapse_to_atm_topo_icemec_filterc(this, bounds) result(filter) + function collapse_to_atm_topo_ice_filterc(this, bounds) result(filter) ! ! !DESCRIPTION: - ! Returns a column-level filter of ice_mec columns with the collapse_to_atm_topo behavior + ! Returns a column-level filter of ice columns with the collapse_to_atm_topo behavior ! ! !USES: use filterColMod, only : filter_col_type, col_filter_from_grcflags_ltypes @@ -1028,7 +1028,7 @@ function collapse_to_atm_topo_icemec_filterc(this, bounds) result(filter) ! ! !LOCAL VARIABLES: - character(len=*), parameter :: subname = 'collapse_to_atm_topo_icemec_filterc' + character(len=*), parameter :: subname = 'collapse_to_atm_topo_ice_filterc' !----------------------------------------------------------------------- ! Currently this creates the filter on the fly, recreating it every time this @@ -1044,10 +1044,10 @@ function collapse_to_atm_topo_icemec_filterc(this, bounds) result(filter) filter = col_filter_from_grcflags_ltypes( & bounds = bounds, & grcflags = this%collapse_to_atm_topo_grc(bounds%begg:bounds%endg), & - ltypes = [istice_mec], & + ltypes = [istice], & include_inactive = .true.) - end function collapse_to_atm_topo_icemec_filterc + end function collapse_to_atm_topo_ice_filterc !----------------------------------------------------------------------- function get_collapse_to_atm_topo(this, gi) result(collapse_to_atm_topo) diff --git a/src/main/histFileMod.F90 b/src/main/histFileMod.F90 index 5c43e1540d..3587e920cb 100644 --- a/src/main/histFileMod.F90 +++ b/src/main/histFileMod.F90 @@ -172,6 +172,7 @@ module histFileMod private :: pointer_index ! Track data pointer indices private :: max_nFields ! The max number of fields on any tape private :: avgflag_valid ! Whether a given avgflag is a valid option + private :: add_landunit_mask_metadata ! Add landunit_mask metadata for the given history field ! ! !PRIVATE TYPES: ! Constants @@ -2086,7 +2087,7 @@ subroutine htape_create (t, histrest) ! ! !USES: use clm_varpar , only : nlevgrnd, nlevsno, nlevlak, nlevurb, nlevmaxurbgrnd, numrad, nlevcan, nvegwcs,nlevsoi - use clm_varpar , only : natpft_size, cft_size, maxpatch_glcmec, nlevdecomp_full + use clm_varpar , only : natpft_size, cft_size, maxpatch_glc, 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 @@ -2234,10 +2235,10 @@ subroutine htape_create (t, histrest) call ncd_defdim(lnfid, 'cft', cft_size, dimid) call htape_add_cft_metadata(lnfid) end if - call ncd_defdim(lnfid, 'glc_nec' , maxpatch_glcmec , dimid) + call ncd_defdim(lnfid, 'glc_nec' , maxpatch_glc , 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) + call ncd_defdim(lnfid, 'elevclas' , maxpatch_glc + 1, dimid) do n = 1,num_subs call ncd_defdim(lnfid, subs_name(n), subs_dim(n), dimid) @@ -2429,7 +2430,7 @@ subroutine htape_timeconst3D(t, & character(len=max_chars) :: long_name ! variable long name character(len=max_namlen):: varname ! variable name character(len=max_namlen):: units ! variable units - character(len=scale_type_strlen) :: l2g_scale_type ! scale type for subgrid averaging of landunits to grid cells + integer :: varid ! variable id ! real(r8), pointer :: histi(:,:) ! temporary real(r8), pointer :: histo(:,:) ! temporary @@ -2443,13 +2444,35 @@ subroutine htape_timeconst3D(t, & 'BSW ', & 'HKSAT ' & /) + ! Scale type for subgrid averaging of landunits to grid cells + ! 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. + character(len=scale_type_strlen) :: l2g_scale_type(nflds) = [ & + 'nonurb', & ! ZSOI + 'nonurb', & ! DZSOI + 'veg ', & ! WATSAT + 'veg ', & ! SUCSAT + 'veg ', & ! BSW + 'veg ' & ! HKSAT + ] real(r8), pointer :: histil(:,:) ! temporary real(r8), pointer :: histol(:,:) integer, parameter :: nfldsl = 2 character(len=*),parameter :: varnamesl(nfldsl) = (/ & 'ZLAKE ', & 'DZLAKE' & - /) + /) + ! Scale type for subgrid averaging of landunits to grid cells, for lake fields + character(len=scale_type_strlen) :: l2g_scale_typel(nfldsl) = [ & + 'lake', & ! ZLAKE + 'lake' & ! DZLAKE + ] !----------------------------------------------------------------------- SHR_ASSERT_ALL_FL((ubound(watsat_col) == (/bounds%endc, nlevmaxurbgrnd/)), sourcefile, __LINE__) @@ -2486,12 +2509,16 @@ subroutine htape_timeconst3D(t, & 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) + long_name=long_name, units=units, missing_value=spval, fill_value=spval, & + varid=varid) 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) + dim1name=grlnd, dim2name='levgrnd', & + long_name=long_name, units=units, missing_value=spval, fill_value=spval, & + varid=varid) end if + + call add_landunit_mask_metadata(nfid(t), varid, l2g_scale_type(ifld)) else call ncd_defvar(ncid=nfid(t), varname=trim(varnames(ifld)), xtype=tape(t)%ncprec, & dim1name=namec, dim2name='levgrnd', & @@ -2520,30 +2547,6 @@ subroutine htape_timeconst3D(t, & do ifld = 1,nflds - ! WJS (10-25-11): Note about l2g_scale_type in the following: ZSOI & DZSOI are - ! currently constant in space, except for urban points, so their scale type - ! doesn't matter at the moment as long as it excludes urban points. I am using - ! 'nonurb' so that the values are output everywhere where the fields are - ! constant (i.e., everywhere except urban points). For the other fields, I am - ! using 'veg' to be consistent with the l2g_scale_type that is now used for many - ! of the 3-d time-variant fields; in theory, though, one might want versions of - ! these variables output for different landunits. - - ! Field indices MUST match varnames array order above! - if (ifld == 1) then ! ZSOI - l2g_scale_type = 'nonurb' - else if (ifld == 2) then ! DZSOI - l2g_scale_type = 'nonurb' - else if (ifld == 3) then ! WATSAT - l2g_scale_type = 'veg' - else if (ifld == 4) then ! SUCSAT - l2g_scale_type = 'veg' - else if (ifld == 5) then ! BSW - l2g_scale_type = 'veg' - else if (ifld == 6) then ! HKSAT - l2g_scale_type = 'veg' - end if - histi(:,:) = spval do lev = 1,nlevgrnd do c = bounds%begc,bounds%endc @@ -2563,7 +2566,7 @@ subroutine htape_timeconst3D(t, & call c2g(bounds, nlevgrnd, & histi(bounds%begc:bounds%endc, :), & histo(bounds%begg:bounds%endg, :), & - c2l_scale_type='unity', l2g_scale_type=l2g_scale_type) + c2l_scale_type='unity', l2g_scale_type=l2g_scale_type(ifld)) if (ldomain%isgrid2d) then call ncd_io(varname=trim(varnames(ifld)), dim1name=grlnd, & @@ -2597,12 +2600,16 @@ subroutine htape_timeconst3D(t, & 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) + long_name=long_name, units=units, missing_value=spval, fill_value=spval, & + varid=varid) 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) + dim1name=grlnd, dim2name='levlak', & + long_name=long_name, units=units, missing_value=spval, fill_value=spval, & + varid=varid) end if + + call add_landunit_mask_metadata(nfid(t), varid, l2g_scale_typel(ifld)) else call ncd_defvar(ncid=nfid(t), varname=trim(varnamesl(ifld)), xtype=tape(t)%ncprec, & dim1name=namec, dim2name='levlak', & @@ -2646,7 +2653,7 @@ subroutine htape_timeconst3D(t, & call c2g(bounds, nlevlak, & histil(bounds%begc:bounds%endc, :), & histol(bounds%begg:bounds%endg, :), & - c2l_scale_type='unity', l2g_scale_type='lake') + c2l_scale_type='unity', l2g_scale_type=l2g_scale_typel(ifld)) if (ldomain%isgrid2d) then call ncd_io(varname=trim(varnamesl(ifld)), dim1name=grlnd, & data=histol, ncid=nfid(t), flag='write') @@ -3116,6 +3123,7 @@ subroutine hfields_write(t, mode) integer :: nt ! time index integer :: ier ! error status integer :: numdims ! number of dimensions + integer :: varid ! variable id character(len=avgflag_strlen) :: avgflag ! time averaging flag character(len=max_chars) :: long_name! long name character(len=max_chars) :: units ! units @@ -3124,6 +3132,7 @@ subroutine hfields_write(t, mode) character(len=hist_dim_name_length) :: type1d ! field 1d type character(len=hist_dim_name_length) :: type1d_out ! history output 1d type character(len=hist_dim_name_length) :: type2d ! history output 2d type + character(len=scale_type_strlen) :: l2g_scale_type character(len=32) :: dim1name ! temporary character(len=32) :: dim2name ! temporary real(r8), pointer :: histo(:,:) ! temporary @@ -3147,21 +3156,22 @@ subroutine hfields_write(t, mode) ! 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 = tape(t)%hlist(f)%field%type1d - type1d_out = tape(t)%hlist(f)%field%type1d_out - beg1d = tape(t)%hlist(f)%field%beg1d - end1d = tape(t)%hlist(f)%field%end1d - 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 - numdims = tape(t)%hlist(f)%field%numdims - num2d = tape(t)%hlist(f)%field%num2d - nt = tape(t)%ntimes + 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 = tape(t)%hlist(f)%field%type1d + type1d_out = tape(t)%hlist(f)%field%type1d_out + beg1d = tape(t)%hlist(f)%field%beg1d + end1d = tape(t)%hlist(f)%field%end1d + 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 + numdims = tape(t)%hlist(f)%field%numdims + num2d = tape(t)%hlist(f)%field%num2d + l2g_scale_type = tape(t)%hlist(f)%field%l2g_scale_type + nt = tape(t)%ntimes if (mode == 'define') then @@ -3196,27 +3206,35 @@ subroutine hfields_write(t, mode) 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) + missing_value=spval, fill_value=spval, & + varid=varid) 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) + missing_value=spval, fill_value=spval, & + varid=varid) end if else if (numdims == 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) + missing_value=spval, fill_value=spval, & + varid=varid) 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) + missing_value=spval, fill_value=spval, & + varid=varid) end if endif + if (type1d_out == nameg .or. type1d_out == grlnd) then + call add_landunit_mask_metadata(nfid(t), varid, l2g_scale_type) + end if + else if (mode == 'write') then ! Determine output buffer @@ -4781,7 +4799,7 @@ 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) + set_noglc, set_spec, default) ! ! !DESCRIPTION: ! Initialize a single level history field. The pointer, ptrhist, @@ -4809,7 +4827,7 @@ subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, & 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_noglc ! value to set non-glacier 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 @@ -4911,10 +4929,10 @@ subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, & if (lun%ifspecial(l)) ptr_col(c) = set_spec end do end if - if (present(set_noglcmec)) then + if (present(set_noglc)) then do c = bounds%begc,bounds%endc l =col%landunit(c) - if (.not.(lun%glcmecpoi(l))) ptr_col(c) = set_noglcmec + if (.not.(lun%glcpoi(l))) ptr_col(c) = set_noglc end do endif @@ -4952,10 +4970,10 @@ subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, & if (lun%ifspecial(l)) ptr_patch(p) = set_spec end do end if - if (present(set_noglcmec)) then + if (present(set_noglc)) then do p = bounds%begp,bounds%endp l =patch%landunit(p) - if (.not.(lun%glcmecpoi(l))) ptr_patch(p) = set_noglcmec + if (.not.(lun%glcpoi(l))) ptr_patch(p) = set_noglc end do end if else @@ -5015,7 +5033,7 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, ! ! !USES: use clm_varpar , only : nlevgrnd, nlevsno, nlevlak, numrad, nlevdecomp_full, nlevcan, nvegwcs,nlevsoi - use clm_varpar , only : natpft_size, cft_size, maxpatch_glcmec + use clm_varpar , only : natpft_size, cft_size, maxpatch_glc use landunit_varcon , only : max_lunit ! ! !ARGUMENTS: @@ -5148,11 +5166,11 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, call endrun() end if case ('glc_nec') - num2d = maxpatch_glcmec + num2d = maxpatch_glc case ('elevclas') ! add one because indexing starts at 0 (elevclas, unlike glc_nec, includes the ! bare ground "elevation class") - num2d = maxpatch_glcmec + 1 + num2d = maxpatch_glc + 1 case ('levsno') num2d = nlevsno case ('nlevcan') @@ -5556,5 +5574,36 @@ function avgflag_valid(avgflag, blank_valid) result(valid) end function avgflag_valid + !----------------------------------------------------------------------- + subroutine add_landunit_mask_metadata(ncid, varid, l2g_scale_type) + ! + ! !DESCRIPTION: + ! Add landunit_mask metadata for the given history field + ! + ! !ARGUMENTS: + class(file_desc_t), intent(inout) :: ncid ! netcdf file id + integer , intent(in) :: varid ! netcdf var id + character(len=*) , intent(in) :: l2g_scale_type ! l2g_scale_type for this variable + ! + ! !LOCAL VARIABLES: + character(len=:), allocatable :: landunit_mask_string + + character(len=*), parameter :: subname = 'add_landunit_mask_metadata' + !----------------------------------------------------------------------- + + if (l2g_scale_type == 'unity') then + ! BUG(wjs, 2021-04-19, ESCOMP/CTSM#1347) Once we consistently set l2g_scale_type + ! for all variables, and have stopped using other mechanisms (particularly the + ! setting of variables to spval everywhere) then we can stop setting this to + ! 'unknown': we can instead set this to something like 'all', with reasonable + ! confidence that the field truly applies over all landunits. + landunit_mask_string = 'unknown' + else + landunit_mask_string = l2g_scale_type + end if + + call ncd_putatt(ncid, varid, 'landunit_mask', landunit_mask_string) + + end subroutine add_landunit_mask_metadata end module histFileMod diff --git a/src/main/initGridCellsMod.F90 b/src/main/initGridCellsMod.F90 index 0d9b20ef7b..eb34161f47 100644 --- a/src/main/initGridCellsMod.F90 +++ b/src/main/initGridCellsMod.F90 @@ -37,7 +37,7 @@ module initGridCellsMod ! !PRIVATE MEMBER FUNCTIONS: private set_landunit_veg_compete private set_landunit_wet_lake - private set_landunit_ice_mec + private set_landunit_ice private set_landunit_crop_noncompete private set_landunit_urban @@ -58,7 +58,7 @@ subroutine initGridcells(glc_behavior) use domainMod , only : ldomain use decompMod , only : get_proc_bounds, get_clump_bounds, get_proc_clumps use subgridWeightsMod , only : compute_higher_order_weights - use landunit_varcon , only : istsoil, istwet, istdlak, istice_mec + use landunit_varcon , only : istsoil, istwet, istdlak, istice use landunit_varcon , only : isturb_tbd, isturb_hd, isturb_md, istcrop use clm_varctl , only : use_fates use shr_const_mod , only : SHR_CONST_PI @@ -174,9 +174,9 @@ subroutine initGridcells(glc_behavior) end do do gdc = bounds_clump%begg,bounds_clump%endg - call set_landunit_ice_mec( & + call set_landunit_ice( & glc_behavior = glc_behavior, & - ltype=istice_mec, gi=gdc, li=li, ci=ci, pi=pi) + ltype=istice, gi=gdc, li=li, ci=ci, pi=pi) end do ! Ensure that we have set the expected number of patchs, cols and landunits for this clump @@ -337,16 +337,16 @@ subroutine set_landunit_wet_lake (ltype, gi, li, ci, pi) end subroutine set_landunit_wet_lake !----------------------------------------------------------------------- - subroutine set_landunit_ice_mec(glc_behavior, ltype, gi, li, ci, pi) + subroutine set_landunit_ice(glc_behavior, ltype, gi, li, ci, pi) ! ! !DESCRIPTION: - ! Initialize glacier_mec landunits + ! Initialize glacier landunits ! ! !USES: - use clm_varpar , only : maxpatch_glcmec + use clm_varpar , only : maxpatch_glc use clm_instur , only : wt_lunit, wt_glc_mec - use landunit_varcon , only : istice_mec - use column_varcon , only : icemec_class_to_col_itype + use landunit_varcon , only : istice + use column_varcon , only : ice_class_to_col_itype use subgridMod , only : subgrid_get_info_glacier_mec use pftconMod , only : noveg ! @@ -369,15 +369,15 @@ subroutine set_landunit_ice_mec(glc_behavior, ltype, gi, li, ci, pi) logical :: type_is_dynamic ! We don't have a true atm_topo value at the point of this call, so arbitrarily use - ! 0. This will put glc_mec in elevation class 1 in some places where it should + ! 0. This will put glc in elevation class 1 in some places where it should ! actually be in a higher elevation class, but that will be adjusted in the run loop ! (or upon reading the restart file). real(r8), parameter :: atm_topo = 0._r8 - character(len=*), parameter :: subname = 'set_landunit_ice_mec' + character(len=*), parameter :: subname = 'set_landunit_ice' !----------------------------------------------------------------------- - SHR_ASSERT_FL(ltype == istice_mec, sourcefile, __LINE__) + SHR_ASSERT_FL(ltype == istice, sourcefile, __LINE__) call subgrid_get_info_glacier_mec(gi, atm_topo, glc_behavior, & npatches=npatches, ncols=ncols, nlunits=nlunits) @@ -396,11 +396,11 @@ subroutine set_landunit_ice_mec(glc_behavior, ltype, gi, li, ci, pi) ! balance in each elevation class wherever the SMB is needed. type_is_dynamic = glc_behavior%cols_have_dynamic_type(gi) - do m = 1, maxpatch_glcmec - call glc_behavior%glc_mec_col_exists(gi = gi, elev_class = m, atm_topo = atm_topo, & + do m = 1, maxpatch_glc + call glc_behavior%glc_col_exists(gi = gi, elev_class = m, atm_topo = atm_topo, & exists = col_exists, col_wt_lunit = wtcol2lunit) if (col_exists) then - call add_column(ci=ci, li=li, ctype=icemec_class_to_col_itype(m), & + call add_column(ci=ci, li=li, ctype=ice_class_to_col_itype(m), & wtlunit=wtcol2lunit, type_is_dynamic=type_is_dynamic) call add_patch(pi=pi, ci=ci, ptype=noveg, wtcol=1.0_r8) endif @@ -410,7 +410,7 @@ subroutine set_landunit_ice_mec(glc_behavior, ltype, gi, li, ci, pi) call endrun(msg=subname//' ERROR: expect 0 or 1 landunits') end if - end subroutine set_landunit_ice_mec + end subroutine set_landunit_ice !------------------------------------------------------------------------ diff --git a/src/main/initSubgridMod.F90 b/src/main/initSubgridMod.F90 index 43851c337b..c2ad61c4bf 100644 --- a/src/main/initSubgridMod.F90 +++ b/src/main/initSubgridMod.F90 @@ -151,7 +151,7 @@ end subroutine clm_ptrs_compdown subroutine clm_ptrs_check(bounds) ! ! !DESCRIPTION: - ! Checks and writes out a summary of subgrid data + ! Checks subgrid data ! ! !USES use clm_varcon, only : ispval @@ -179,9 +179,6 @@ subroutine clm_ptrs_check(bounds) endp => bounds%endp & ) - if (masterproc) write(iulog,*) ' ' - if (masterproc) write(iulog,*) '---clm_ptrs_check:' - !--- check index ranges --- error = .false. do g = begg, endg @@ -193,10 +190,10 @@ subroutine clm_ptrs_check(bounds) end do end do if (error) then - write(iulog,*) ' clm_ptrs_check: g index ranges - ERROR' - call endrun(msg=errMsg(sourcefile, __LINE__)) + call endrun( & + msg = 'clm_ptrs_check: g index ranges - ERROR', & + additional_msg = errMsg(sourcefile, __LINE__)) end if - if (masterproc) write(iulog,*) ' clm_ptrs_check: g index ranges - OK' error = .false. if (minval(lun%gridcell(begl:endl)) < begg .or. maxval(lun%gridcell(begl:endl)) > endg) error=.true. @@ -205,10 +202,10 @@ subroutine clm_ptrs_check(bounds) if (minval(lun%patchi(begl:endl)) < begp .or. maxval(lun%patchi(begl:endl)) > endp) error=.true. if (minval(lun%patchf(begl:endl)) < begp .or. maxval(lun%patchf(begl:endl)) > endp) error=.true. if (error) then - write(iulog,*) ' clm_ptrs_check: l index ranges - ERROR' - call endrun(msg=errMsg(sourcefile, __LINE__)) + call endrun( & + msg = 'clm_ptrs_check: l index ranges - ERROR', & + additional_msg = errMsg(sourcefile, __LINE__)) endif - if (masterproc) write(iulog,*) ' clm_ptrs_check: l index ranges - OK' error = .false. if (minval(col%gridcell(begc:endc)) < begg .or. maxval(col%gridcell(begc:endc)) > endg) error=.true. @@ -216,20 +213,20 @@ subroutine clm_ptrs_check(bounds) if (minval(col%patchi(begc:endc)) < begp .or. maxval(col%patchi(begc:endc)) > endp) error=.true. if (minval(col%patchf(begc:endc)) < begp .or. maxval(col%patchf(begc:endc)) > endp) error=.true. if (error) then - write(iulog,*) ' clm_ptrs_check: c index ranges - ERROR' - call endrun(msg=errMsg(sourcefile, __LINE__)) + call endrun( & + msg = 'clm_ptrs_check: c index ranges - ERROR', & + additional_msg = errMsg(sourcefile, __LINE__)) endif - if (masterproc) write(iulog,*) ' clm_ptrs_check: c index ranges - OK' error = .false. if (minval(patch%gridcell(begp:endp)) < begg .or. maxval(patch%gridcell(begp:endp)) > endg) error=.true. if (minval(patch%landunit(begp:endp)) < begl .or. maxval(patch%landunit(begp:endp)) > endl) error=.true. if (minval(patch%column(begp:endp)) < begc .or. maxval(patch%column(begp:endp)) > endc) error=.true. if (error) then - write(iulog,*) ' clm_ptrs_check: p index ranges - ERROR' - call endrun(msg=errMsg(sourcefile, __LINE__)) + call endrun( & + msg = 'clm_ptrs_check: p index ranges - ERROR', & + additional_msg = errMsg(sourcefile, __LINE__)) endif - if (masterproc) write(iulog,*) ' clm_ptrs_check: p index ranges - OK' !--- check that indices in arrays are monotonically increasing --- error = .false. @@ -244,11 +241,11 @@ subroutine clm_ptrs_check(bounds) if (lun%patchi(l) < lun%patchi(l-1)) error = .true. if (lun%patchf(l) < lun%patchf(l-1)) error = .true. if (error) then - write(iulog,*) ' clm_ptrs_check: l mono increasing - ERROR' - call endrun(decomp_index=l, clmlevel=namel, msg=errMsg(sourcefile, __LINE__)) + call endrun(decomp_index=l, clmlevel=namel, & + msg = 'clm_ptrs_check: l mono increasing - ERROR', & + additional_msg = errMsg(sourcefile, __LINE__)) endif enddo - if (masterproc) write(iulog,*) ' clm_ptrs_check: l mono increasing - OK' error = .false. do c=begc+1,endc @@ -263,11 +260,11 @@ subroutine clm_ptrs_check(bounds) if (col%patchi(c) < col%patchi(c-1)) error = .true. if (col%patchf(c) < col%patchf(c-1)) error = .true. if (error) then - write(iulog,*) ' clm_ptrs_check: c mono increasing - ERROR' - call endrun(decomp_index=c, clmlevel=namec, msg=errMsg(sourcefile, __LINE__)) + call endrun(decomp_index=c, clmlevel=namec, & + msg = 'clm_ptrs_check: c mono increasing - ERROR', & + additional_msg = errMsg(sourcefile, __LINE__)) endif enddo - if (masterproc) write(iulog,*) ' clm_ptrs_check: c mono increasing - OK' error = .false. do p=begp+1,endp @@ -281,11 +278,11 @@ subroutine clm_ptrs_check(bounds) if (patch%landunit(p) < patch%landunit(p-1)) error = .true. if (patch%column (p) < patch%column (p-1)) error = .true. if (error) then - write(iulog,*) ' clm_ptrs_check: p mono increasing - ERROR' - call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(sourcefile, __LINE__)) + call endrun(decomp_index=p, clmlevel=namep, & + msg = 'clm_ptrs_check: p mono increasing - ERROR', & + additional_msg = errMsg(sourcefile, __LINE__)) endif enddo - if (masterproc) write(iulog,*) ' clm_ptrs_check: p mono increasing - OK' !--- check that the tree is internally consistent --- error = .false. @@ -298,34 +295,35 @@ subroutine clm_ptrs_check(bounds) if (lun%itype(l) /= ltype) error = .true. if (lun%gridcell(l) /= g) error = .true. if (error) then - write(iulog,*) ' clm_ptrs_check: tree consistent - ERROR' - call endrun(decomp_index=l, clmlevel=namel, msg=errMsg(sourcefile, __LINE__)) + call endrun(decomp_index=l, clmlevel=namel, & + msg = 'clm_ptrs_check: tree consistent - ERROR', & + additional_msg = errMsg(sourcefile, __LINE__)) endif do c = lun%coli(l),lun%colf(l) if (col%gridcell(c) /= g) error = .true. if (col%landunit(c) /= l) error = .true. if (error) then - write(iulog,*) ' clm_ptrs_check: tree consistent - ERROR' - call endrun(decomp_index=c, clmlevel=namec, msg=errMsg(sourcefile, __LINE__)) + call endrun(decomp_index=c, clmlevel=namec, & + msg = 'clm_ptrs_check: tree consistent - ERROR', & + additional_msg = errMsg(sourcefile, __LINE__)) endif do p = col%patchi(c),col%patchf(c) if (patch%gridcell(p) /= g) error = .true. if (patch%landunit(p) /= l) error = .true. if (patch%column(p) /= c) error = .true. if (error) then - write(iulog,*) ' clm_ptrs_check: tree consistent - ERROR' - call endrun(decomp_index=p, clmlevel=namep, msg=errMsg(sourcefile, __LINE__)) + call endrun(decomp_index=p, clmlevel=namep, & + msg = 'clm_ptrs_check: tree consistent - ERROR', & + additional_msg = errMsg(sourcefile, __LINE__)) endif enddo ! p enddo ! c end if ! l /= ispval enddo ! ltype enddo ! g - if (masterproc) write(iulog,*) ' clm_ptrs_check: tree consistent - OK' - if (masterproc) write(iulog,*) ' ' end associate - + end subroutine clm_ptrs_check !----------------------------------------------------------------------- @@ -337,7 +335,7 @@ subroutine add_landunit(li, gi, ltype, wtgcell) ! accordingly. ! ! !USES: - use landunit_varcon , only : istice_mec, istdlak, isturb_MIN, isturb_MAX, landunit_is_special + use landunit_varcon , only : istice, istdlak, isturb_MIN, isturb_MAX, landunit_is_special ! ! !ARGUMENTS: integer , intent(inout) :: li ! input value is index of last landunit added; output value is index of this newly-added landunit @@ -358,10 +356,10 @@ subroutine add_landunit(li, gi, ltype, wtgcell) lun%ifspecial(li) = landunit_is_special(ltype) - if (ltype == istice_mec) then - lun%glcmecpoi(li) = .true. + if (ltype == istice) then + lun%glcpoi(li) = .true. else - lun%glcmecpoi(li) = .false. + lun%glcpoi(li) = .false. end if if (ltype == istdlak) then diff --git a/src/main/initVerticalMod.F90 b/src/main/initVerticalMod.F90 index 58bf29afce..69368f217a 100644 --- a/src/main/initVerticalMod.F90 +++ b/src/main/initVerticalMod.F90 @@ -22,13 +22,12 @@ module initVerticalMod use clm_varctl , only : use_fates use clm_varcon , only : zlak, dzlak, zsoi, dzsoi, zisoi, dzsoi_decomp, spval, ispval, grlnd use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall, is_hydrologically_active - use landunit_varcon , only : istdlak, istice_mec + use landunit_varcon , only : istdlak, istice use fileutils , only : getfil use LandunitType , only : lun use GridcellType , only : grc use ColumnType , only : col use glcBehaviorMod , only : glc_behavior_type - use SnowHydrologyMod , only : InitSnowLayers use abortUtils , only : endrun use ncdio_pio ! @@ -54,13 +53,12 @@ module initVerticalMod contains !------------------------------------------------------------------------ - subroutine initVertical(bounds, glc_behavior, snow_depth, thick_wall, thick_roof) + subroutine initVertical(bounds, glc_behavior, thick_wall, thick_roof) use clm_varcon, only : zmin_bedrock ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds type(glc_behavior_type), intent(in) :: glc_behavior - real(r8) , intent(in) :: snow_depth(bounds%begc:) real(r8) , intent(in) :: thick_wall(bounds%begl:) real(r8) , intent(in) :: thick_roof(bounds%begl:) ! @@ -118,7 +116,6 @@ subroutine initVertical(bounds, glc_behavior, snow_depth, thick_wall, thick_roof begc = bounds%begc; endc= bounds%endc begl = bounds%begl; endl= bounds%endl - SHR_ASSERT_ALL_FL((ubound(snow_depth) == (/endc/)), sourcefile, __LINE__) SHR_ASSERT_ALL_FL((ubound(thick_wall) == (/endl/)), sourcefile, __LINE__) SHR_ASSERT_ALL_FL((ubound(thick_roof) == (/endl/)), sourcefile, __LINE__) @@ -651,12 +648,6 @@ subroutine initVertical(bounds, glc_behavior, snow_depth, thick_wall, thick_roof end do end do - !----------------------------------------------- - ! Set cold-start values for snow levels, snow layers and snow interfaces - !----------------------------------------------- - - call InitSnowLayers(bounds, snow_depth(bounds%begc:bounds%endc)) - !----------------------------------------------- ! Read in topographic index and slope !----------------------------------------------- @@ -760,7 +751,7 @@ logical function hasBedrock(col_itype, lun_itype) ! from the upper layers. ! ! !USES: - use landunit_varcon, only : istice_mec, isturb_MIN, isturb_MAX + use landunit_varcon, only : istice, isturb_MIN, isturb_MAX use column_varcon , only : icol_road_perv ! ! !ARGUMENTS: @@ -784,7 +775,7 @@ logical function hasBedrock(col_itype, lun_itype) ! == istdlak - that way, hasBedrock(lake) would be more likely to get updated ! correctly if the lake logic changes. - if (lun_itype == istice_mec) then + if (lun_itype == istice) then hasBedrock = .false. else if (lun_itype >= isturb_MIN .and. lun_itype <= isturb_MAX) then if (col_itype == icol_road_perv) then diff --git a/src/main/landunit_varcon.F90 b/src/main/landunit_varcon.F90 index b6ddc7cf5c..36eccb7001 100644 --- a/src/main/landunit_varcon.F90 +++ b/src/main/landunit_varcon.F90 @@ -18,8 +18,10 @@ module landunit_varcon integer, parameter, public :: istsoil = 1 !soil landunit type (natural vegetation) integer, parameter, public :: istcrop = 2 !crop landunit type - ! Landunit 3 currently unused (used to be non-multiple elevation class glacier type: istice) - integer, parameter, public :: istice_mec = 4 !land ice (multiple elevation classes) landunit type + ! Landunit 3 currently unused (used to be non-multiple elevation class glacier type: + ! istice, and landunit 4 was istice_mec; now they are combined into a single landunit + ! type, 4) + integer, parameter, public :: istice = 4 !land ice 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.) @@ -117,7 +119,7 @@ subroutine set_landunit_names landunit_names(istsoil) = 'vegetated_or_bare_soil' landunit_names(istcrop) = 'crop' landunit_names(istcrop+1) = unused - landunit_names(istice_mec) = 'landice_multiple_elevation_classes' + landunit_names(istice) = 'landice' landunit_names(istdlak) = 'deep_lake' landunit_names(istwet) = 'wetland' landunit_names(isturb_tbd) = 'urban_tbd' diff --git a/src/main/lnd2atmMod.F90 b/src/main/lnd2atmMod.F90 index 7aed89f3fa..ff7324e428 100644 --- a/src/main/lnd2atmMod.F90 +++ b/src/main/lnd2atmMod.F90 @@ -36,7 +36,7 @@ module lnd2atmMod use ColumnType , only : col use LandunitType , only : lun use GridcellType , only : grc - use landunit_varcon , only : istice_mec + use landunit_varcon , only : istice ! ! !PUBLIC TYPES: implicit none @@ -180,7 +180,6 @@ subroutine lnd2atm(bounds, & ! ! !LOCAL VARIABLES: integer :: c, g ! indices - real(r8) :: qflx_ice_runoff_col(bounds%begc:bounds%endc) ! total column-level ice runoff real(r8) :: eflx_sh_ice_to_liq_grc(bounds%begg:bounds%endg) ! sensible heat flux generated from the ice to liquid conversion, averaged to gridcell real(r8), parameter :: amC = 12.0_r8 ! Atomic mass number for Carbon real(r8), parameter :: amO = 16.0_r8 ! Atomic mass number for Oxygen @@ -193,7 +192,7 @@ subroutine lnd2atm(bounds, & call handle_ice_runoff(bounds, water_inst%waterfluxbulk_inst, glc_behavior, & melt_non_icesheet_ice_runoff = lnd2atm_inst%params%melt_non_icesheet_ice_runoff, & - qflx_ice_runoff_col = qflx_ice_runoff_col(bounds%begc:bounds%endc), & + qflx_ice_runoff_col = water_inst%waterlnd2atmbulk_inst%qflx_ice_runoff_col(bounds%begc:bounds%endc), & qflx_liq_from_ice_col = water_inst%waterlnd2atmbulk_inst%qflx_liq_from_ice_col(bounds%begc:bounds%endc), & eflx_sh_ice_to_liq_col = lnd2atm_inst%eflx_sh_ice_to_liq_col(bounds%begc:bounds%endc)) @@ -359,8 +358,9 @@ subroutine lnd2atm(bounds, & ! qflx_runoff is the sum of a number of terms, including qflx_qrgwl. Since we ! are adjusting qflx_qrgwl above, we need to adjust qflx_runoff analogously. - water_inst%waterfluxbulk_inst%qflx_runoff_col(c) = water_inst%waterfluxbulk_inst%qflx_runoff_col(c) + & - water_inst%waterlnd2atmbulk_inst%qflx_liq_from_ice_col(c) + water_inst%waterfluxbulk_inst%qflx_runoff_col(c) = & + water_inst%waterfluxbulk_inst%qflx_runoff_col(c) + & + water_inst%waterlnd2atmbulk_inst%qflx_liq_from_ice_col(c) end if end do @@ -375,8 +375,12 @@ subroutine lnd2atm(bounds, & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) do g = bounds%begg, bounds%endg - water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc(g) = water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc(g) - water_inst%waterfluxbulk_inst%qflx_liq_dynbal_grc(g) - water_inst%waterlnd2atmbulk_inst%qflx_rofliq_grc(g) = water_inst%waterlnd2atmbulk_inst%qflx_rofliq_grc(g) - water_inst%waterfluxbulk_inst%qflx_liq_dynbal_grc(g) + water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc(g) = & + water_inst%waterlnd2atmbulk_inst%qflx_rofliq_qgwl_grc(g) - & + water_inst%waterfluxbulk_inst%qflx_liq_dynbal_grc(g) + water_inst%waterlnd2atmbulk_inst%qflx_rofliq_grc(g) = & + water_inst%waterlnd2atmbulk_inst%qflx_rofliq_grc(g) - & + water_inst%waterfluxbulk_inst%qflx_liq_dynbal_grc(g) enddo call c2g( bounds, & @@ -391,11 +395,13 @@ subroutine lnd2atm(bounds, & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) call c2g( bounds, & - qflx_ice_runoff_col(bounds%begc:bounds%endc), & + water_inst%waterlnd2atmbulk_inst%qflx_ice_runoff_col(bounds%begc:bounds%endc), & water_inst%waterlnd2atmbulk_inst%qflx_rofice_grc(bounds%begg:bounds%endg), & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) do g = bounds%begg, bounds%endg - water_inst%waterlnd2atmbulk_inst%qflx_rofice_grc(g) = water_inst%waterlnd2atmbulk_inst%qflx_rofice_grc(g) - water_inst%waterfluxbulk_inst%qflx_ice_dynbal_grc(g) + water_inst%waterlnd2atmbulk_inst%qflx_rofice_grc(g) = & + water_inst%waterlnd2atmbulk_inst%qflx_rofice_grc(g) - & + water_inst%waterfluxbulk_inst%qflx_ice_dynbal_grc(g) enddo ! calculate total water storage for history files @@ -405,10 +411,12 @@ subroutine lnd2atm(bounds, & call c2g( bounds, & water_inst%waterbalancebulk_inst%endwb_col(bounds%begc:bounds%endc), & - water_inst%waterdiagnosticbulk_inst%tws_grc (bounds%begg:bounds%endg), & + water_inst%waterdiagnosticbulk_inst%tws_grc(bounds%begg:bounds%endg), & c2l_scale_type= 'urbanf', l2g_scale_type='unity' ) do g = bounds%begg, bounds%endg - water_inst%waterdiagnosticbulk_inst%tws_grc(g) = water_inst%waterdiagnosticbulk_inst%tws_grc(g) + water_inst%wateratm2lndbulk_inst%volr_grc(g) / grc%area(g) * 1.e-3_r8 + water_inst%waterdiagnosticbulk_inst%tws_grc(g) = & + water_inst%waterdiagnosticbulk_inst%tws_grc(g) + & + water_inst%wateratm2lndbulk_inst%volr_grc(g) / grc%area(g) * 1.e-3_r8 enddo end subroutine lnd2atm @@ -479,9 +487,9 @@ subroutine handle_ice_runoff(bounds, waterfluxbulk_inst, glc_behavior, & l = col%landunit(c) g = col%gridcell(c) do_conversion = .false. - if (lun%itype(l) /= istice_mec) then + if (lun%itype(l) /= istice) then do_conversion = .true. - else ! istice_mec + else ! istice if (glc_behavior%ice_runoff_melted_grc(g)) then do_conversion = .true. else diff --git a/src/main/lnd2glcMod.F90 b/src/main/lnd2glcMod.F90 index f48b3ef8b2..7d4fad7791 100644 --- a/src/main/lnd2glcMod.F90 +++ b/src/main/lnd2glcMod.F90 @@ -19,11 +19,11 @@ module lnd2glcMod 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_varpar , only : maxpatch_glc 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 column_varcon , only : col_itype_to_ice_class + use landunit_varcon , only : istice, istsoil use abortutils , only : endrun use TemperatureType , only : temperature_type use WaterFluxBulkType , only : waterfluxbulk_type @@ -97,9 +97,9 @@ subroutine InitAllocate(this, bounds) 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 + allocate(this%tsrf_grc(begg:endg,0:maxpatch_glc)) ; this%tsrf_grc(:,:)=0.0_r8 + allocate(this%topo_grc(begg:endg,0:maxpatch_glc)) ; this%topo_grc(:,:)=0.0_r8 + allocate(this%qice_grc(begg:endg,0:maxpatch_glc)) ; this%qice_grc(:,:)=0.0_r8 end subroutine InitAllocate @@ -120,23 +120,23 @@ subroutine InitHistory(this, bounds) begg = bounds%begg; endg = bounds%endg - this%qice_grc(begg:endg,0:maxpatch_glcmec) = spval + this%qice_grc(begg:endg,0:maxpatch_glc) = 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) + data2dptr => this%qice_grc(:,0:maxpatch_glc) 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) + this%tsrf_grc(begg:endg,0:maxpatch_glc) = spval + data2dptr => this%tsrf_grc(:,0:maxpatch_glc) 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) + this%topo_grc(begg:endg,0:maxpatch_glc) = spval + data2dptr => this%topo_grc(:,0:maxpatch_glc) call hist_addfld2d (fname='TOPO_FORC', units='m', type2d='elevclas', & avgflag='A', long_name='topograephic height sent to GLC', & ptr_lnd=data2dptr, default='inactive') @@ -163,7 +163,7 @@ subroutine update_lnd2glc(this, bounds, num_do_smb_c, filter_do_smb_c, & ! ! !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] + logical, allocatable :: fields_assigned(:,:) ! tracks whether fields have already been assigned for each index [begg:endg, 0:maxpatch_glc] real(r8) :: flux_normalization ! factor by which fluxes should be normalized character(len=*), parameter :: subname = 'update_lnd2glc' @@ -177,7 +177,7 @@ subroutine update_lnd2glc(this, bounds, num_do_smb_c, filter_do_smb_c, & ! Fill the lnd->glc data on the clm grid - allocate(fields_assigned(bounds%begg:bounds%endg, 0:maxpatch_glcmec)) + allocate(fields_assigned(bounds%begg:bounds%endg, 0:maxpatch_glc)) fields_assigned(:,:) = .false. do fc = 1, num_do_smb_c @@ -186,8 +186,8 @@ subroutine update_lnd2glc(this, bounds, num_do_smb_c, filter_do_smb_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)) + if (lun%itype(l) == istice) then + n = col_itype_to_ice_class(col%itype(c)) flux_normalization = 1.0_r8 else if (lun%itype(l) == istsoil) then n = 0 !0-level index (bareland information) @@ -287,7 +287,7 @@ real(r8) function bareland_normalization(c) g = col%gridcell(c) - area_glacier = get_landunit_weight(g, istice_mec) + area_glacier = get_landunit_weight(g, istice) if (abs(area_glacier - 1.0_r8) < tol) then ! If the whole grid cell is glacier, then the normalization factor is arbitrary; diff --git a/src/main/ncdio_pio.F90.in b/src/main/ncdio_pio.F90.in index 4b7b75c82e..b321dc04bc 100644 --- a/src/main/ncdio_pio.F90.in +++ b/src/main/ncdio_pio.F90.in @@ -1212,7 +1212,8 @@ contains 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 ) + flag_meanings, flag_values, nvalid_range, & + varid) ! ! !DESCRIPTION: ! Define a netcdf variable @@ -1238,12 +1239,13 @@ contains 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 + integer , intent(out), optional :: varid ! returned var id ! ! !LOCAL VARIABLES: integer :: n ! indices integer :: ndims ! dimension counter integer :: dimid(5) ! dimension ids - integer :: varid ! variable id + integer :: l_varid ! local variable id integer :: itmp ! temporary character(len=256) :: str ! temporary character(len=*),parameter :: subname='ncd_defvar_bygrid' ! subroutine name @@ -1276,13 +1278,17 @@ contains end do end if - call ncd_defvar_bynf(ncid,varname,xtype,ndims,dimid,varid, & + call ncd_defvar_bynf(ncid,varname,xtype,ndims,dimid,l_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 ) + if (present(varid)) then + varid = l_varid + end if + end subroutine ncd_defvar_bygrid !------------------------------------------------------------------------ diff --git a/src/main/pftconMod.F90 b/src/main/pftconMod.F90 index 88e5965051..3645a6f63a 100644 --- a/src/main/pftconMod.F90 +++ b/src/main/pftconMod.F90 @@ -210,6 +210,7 @@ module pftconMod 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 :: season_decid_temperate(:) ! binary flag for seasonal-deciduous temperate 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 @@ -424,6 +425,7 @@ subroutine InitAllocate (this) allocate( this%evergreen (0:mxpft) ) allocate( this%stress_decid (0:mxpft) ) allocate( this%season_decid (0:mxpft) ) + allocate( this%season_decid_temperate (0:mxpft) ) allocate( this%dwood (0:mxpft) ) allocate( this%root_density (0:mxpft) ) allocate( this%root_radius (0:mxpft) ) @@ -765,6 +767,9 @@ subroutine InitRead(this) call ncd_io('season_decid', this%season_decid, 'read', ncid, readvar=readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + call ncd_io('season_decid_temperate', this%season_decid_temperate, 'read', ncid, readvar=readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) + call ncd_io('pftpar20', this%pftpar20, 'read', ncid, readvar=readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) @@ -1416,6 +1421,7 @@ subroutine Clean(this) deallocate( this%evergreen) deallocate( this%stress_decid) deallocate( this%season_decid) + deallocate( this%season_decid_temperate) deallocate( this%dwood) deallocate( this%root_density) deallocate( this%root_radius) diff --git a/src/main/restFileMod.F90 b/src/main/restFileMod.F90 index 0e60653930..2f62795c7e 100644 --- a/src/main/restFileMod.F90 +++ b/src/main/restFileMod.F90 @@ -506,7 +506,7 @@ subroutine restFile_dimset( ncid ) use clm_varctl , only : conventions, source use dynSubgridControlMod , only : get_flanduse_timeseries use clm_varpar , only : numrad, nlevlak, nlevsno, nlevgrnd, nlevmaxurbgrnd, nlevcan - use clm_varpar , only : maxpatch_glcmec, nvegwcs + use clm_varpar , only : maxpatch_glc, nvegwcs use decompMod , only : get_proc_global ! ! !ARGUMENTS: @@ -548,8 +548,8 @@ subroutine restFile_dimset( ncid ) if ( use_hydrstress ) then call ncd_defdim(ncid , 'vegwcs' , nvegwcs , dimid) end if - call ncd_defdim(ncid , 'glc_nec', maxpatch_glcmec, dimid) - call ncd_defdim(ncid , 'glc_nec1', maxpatch_glcmec+1, dimid) + call ncd_defdim(ncid , 'glc_nec', maxpatch_glc, dimid) + call ncd_defdim(ncid , 'glc_nec1', maxpatch_glc+1, dimid) ! Define global attributes diff --git a/src/main/subgridAveMod.F90 b/src/main/subgridAveMod.F90 index 36c7a0874f..a808aa49d0 100644 --- a/src/main/subgridAveMod.F90 +++ b/src/main/subgridAveMod.F90 @@ -1301,7 +1301,7 @@ subroutine create_scale_l2g_lookup(l2g_scale_type, scale_lookup) ! each landunit type depending on l2g_scale_type ! ! !USES: - use landunit_varcon, only : istsoil, istcrop, istice_mec, istdlak + use landunit_varcon, only : istsoil, istcrop, istice, istdlak use landunit_varcon, only : isturb_MIN, isturb_MAX, max_lunit ! ! !ARGUMENTS: @@ -1342,7 +1342,7 @@ subroutine create_scale_l2g_lookup(l2g_scale_type, scale_lookup) scale_lookup(istsoil) = 1.0_r8 scale_lookup(istcrop) = 1.0_r8 else if (l2g_scale_type == 'ice') then - scale_lookup(istice_mec) = 1.0_r8 + scale_lookup(istice) = 1.0_r8 else if (l2g_scale_type == 'nonurb') then scale_lookup(:) = 1.0_r8 scale_lookup(isturb_MIN:isturb_MAX) = spval diff --git a/src/main/subgridMod.F90 b/src/main/subgridMod.F90 index 296e3d215e..42a3bb0fb9 100644 --- a/src/main/subgridMod.F90 +++ b/src/main/subgridMod.F90 @@ -459,7 +459,7 @@ subroutine subgrid_get_info_glacier_mec(gi, atm_topo, glc_behavior, npatches, nc character(len=*), parameter :: subname = 'subgrid_get_info_glacier_mec' !----------------------------------------------------------------------- - call glc_behavior%get_num_glc_mec_subgrid(gi, atm_topo, npatches, ncols, nlunits) + call glc_behavior%get_num_glc_subgrid(gi, atm_topo, npatches, ncols, nlunits) end subroutine subgrid_get_info_glacier_mec diff --git a/src/main/subgridWeightsMod.F90 b/src/main/subgridWeightsMod.F90 index 3b67fd7574..68b858c682 100644 --- a/src/main/subgridWeightsMod.F90 +++ b/src/main/subgridWeightsMod.F90 @@ -126,7 +126,7 @@ module subgridWeightsMod 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] + real(r8), pointer :: pct_glc_mec(:,:) ! % of each glacier elevation class, as % of landunit [begg:endg, 1:maxpatch_glc] end type subgrid_weights_diagnostics_type type(subgrid_weights_diagnostics_type) :: subgrid_weights_diagnostics @@ -155,7 +155,7 @@ subroutine init_subgrid_weights_mod(bounds) ! ! !USES: use landunit_varcon, only : max_lunit - use clm_varpar , only : maxpatch_glcmec, natpft_size, cft_size + use clm_varpar , only : maxpatch_glc, 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 @@ -183,7 +183,7 @@ subroutine init_subgrid_weights_mod(bounds) 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)) + allocate(subgrid_weights_diagnostics%pct_glc_mec(bounds%begg:bounds%endg, 1:maxpatch_glc)) subgrid_weights_diagnostics%pct_glc_mec(:,:) = nan ! ------------------------------------------------------------------------ @@ -207,7 +207,7 @@ subroutine init_subgrid_weights_mod(bounds) end if call hist_addfld2d (fname='PCT_GLC_MEC', units='%', type2d='glc_nec', & - avgflag='A', long_name='% of each GLC elevation class on the glc_mec landunit', & + avgflag='A', long_name='% of each GLC elevation class on the glacier landunit', & ptr_lnd=subgrid_weights_diagnostics%pct_glc_mec) end subroutine init_subgrid_weights_mod @@ -301,7 +301,7 @@ logical function is_active_l(l, glc_behavior) ! Determine whether the given landunit is active ! ! !USES: - use landunit_varcon, only : istsoil, istice_mec, isturb_MIN, isturb_MAX, istdlak + use landunit_varcon, only : istsoil, istice, isturb_MIN, isturb_MAX, istdlak ! ! !ARGUMENTS: implicit none @@ -330,7 +330,7 @@ logical function is_active_l(l, glc_behavior) ! Conditions under which is_active_p is set to true because we want extra virtual landunits: ! ------------------------------------------------------------------------ - if (lun%itype(l) == istice_mec .and. & + if (lun%itype(l) == istice .and. & glc_behavior%has_virtual_columns_grc(g)) then is_active_l = .true. end if @@ -381,7 +381,7 @@ logical function is_active_c(c, glc_behavior) ! Determine whether the given column is active ! ! !USES: - use landunit_varcon, only : istice_mec, isturb_MIN, isturb_MAX + use landunit_varcon, only : istice, isturb_MIN, isturb_MAX ! ! !ARGUMENTS: implicit none @@ -412,7 +412,7 @@ logical function is_active_c(c, glc_behavior) ! Conditions under which is_active_c is set to true because we want extra virtual columns: ! ------------------------------------------------------------------------ - if (lun%itype(l) == istice_mec .and. & + if (lun%itype(l) == istice .and. & glc_behavior%has_virtual_columns_grc(g)) then is_active_c = .true. end if @@ -797,25 +797,22 @@ 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. + ! Set pct_glc_mec diagnostic field: % of each glc_mec column on the glc landunit ! ! 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. + ! not have a glc landunit. However, it will still sum to 100% for a grid cell + ! that has a 0-weight (i.e., virtual) glc landunit. ! ! !USES: - use landunit_varcon, only : istice_mec - use column_varcon, only : col_itype_to_icemec_class + use landunit_varcon, only : istice + use column_varcon, only : col_itype_to_ice_class ! ! !ARGUMENTS: type(bounds_type), intent(in) :: bounds ! ! !LOCAL VARIABLES: integer :: c,l,g ! indices - integer :: icemec_class ! icemec class (1..maxpatch_glcmec) + integer :: ice_class ! ice class (1..maxpatch_glc) character(len=*), parameter :: subname = 'set_pct_glc_mec_diagnostics' !----------------------------------------------------------------------- @@ -825,9 +822,9 @@ subroutine set_pct_glc_mec_diagnostics(bounds) 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 + if (lun%itype(l) == istice) then + ice_class = col_itype_to_ice_class(col%itype(c)) + subgrid_weights_diagnostics%pct_glc_mec(g, ice_class) = col%wtlunit(c) * 100._r8 end if end do diff --git a/src/main/surfrdMod.F90 b/src/main/surfrdMod.F90 index 6412fafe9c..24aeac40dc 100644 --- a/src/main/surfrdMod.F90 +++ b/src/main/surfrdMod.F90 @@ -15,7 +15,8 @@ module surfrdMod use clm_varcon , only : grlnd use clm_varctl , only : iulog use clm_varctl , only : use_cndv, use_crop - use surfrdUtilsMod , only : check_sums_equal_1, collapse_crop_types, collapse_to_dominant, collapse_crop_var, collapse_individual_lunits + use surfrdUtilsMod , only : check_sums_equal_1, collapse_crop_types + use surfrdUtilsMod , only : collapse_to_dominant, collapse_crop_var, collapse_individual_lunits 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_size, ncd_inqdid, ncd_inqdlen use pio @@ -26,238 +27,23 @@ module surfrdMod 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_data ! Read surface dataset and determine subgrid weights + public :: surfrd_get_data ! Read surface dataset and determine subgrid weights public :: surfrd_get_num_patches ! Read surface dataset to determine maxsoil_patches and numcft ! !PRIVATE MEMBER FUNCTIONS: - private :: surfrd_special ! Read the special landunits - private :: surfrd_veg_all ! Read all of the vegetated landunits - private :: surfrd_veg_dgvm ! Read vegetated landunits for DGVM mode - private :: surfrd_pftformat ! Read crop pfts in file format where they are part of the vegetated land unit - private :: surfrd_cftformat ! Read crop pfts in file format where they are on their own landunit + private :: surfrd_special ! Read the special landunits + private :: surfrd_veg_all ! Read all of the vegetated landunits + private :: surfrd_veg_dgvm ! Read vegetated landunits for DGVM mode + private :: surfrd_pftformat ! Read crop pfts in file format where they are part of the vegetated land unit + private :: surfrd_cftformat ! Read crop pfts in file format where they are on their own landunit ! ! !PRIVATE DATA MEMBERS: - ! default multiplication factor for epsilon for error checks - real(r8), private, parameter :: eps_fact = 2._r8 - character(len=*), parameter, private :: sourcefile = & __FILE__ !----------------------------------------------------------------------- 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 - 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(sourcefile, __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(sourcefile, __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 - 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(sourcefile, __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='xc', readvar=readvar) - if (readvar)then - istype_domain = .true. - else - istype_domain = .false. - end if - - ! 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(sourcefile, __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(sourcefile, __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(sourcefile, __LINE__)) - else - call endrun( msg=" ERROR: can no longer read non domain files" ) - end if - - if (isgrid2d) then - allocate(rdata2d(ni,nj), lon1d(ni), lat1d(nj)) - if (istype_domain) vname = 'xc' - call ncd_io(ncid=ncid, varname=trim(vname), data=rdata2d, flag='read', readvar=readvar) - lon1d(:) = rdata2d(:,1) - if (istype_domain) vname = 'yc' - 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(sourcefile, __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 - if ( any(ldomain%lonc < 0.0_r8) )then - call endrun( msg=' ERROR: lonc is negative and currently can NOT be (see https://github.com/ESCOMP/ctsm/issues/507)' & - //errMsg(sourcefile, __LINE__)) - endif - - 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(sourcefile, __LINE__)) - end if - - 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(sourcefile, __LINE__)) - end if - - call ncd_pio_closefile(ncid) - - end subroutine surfrd_get_grid - !----------------------------------------------------------------------- subroutine surfrd_get_data (begg, endg, ldomain, lfsurdat, actual_numcft) ! @@ -339,7 +125,7 @@ subroutine surfrd_get_data (begg, endg, ldomain, lfsurdat, actual_numcft) dim1name=grlnd, readvar=readvar) if (.not. readvar) call endrun( msg=' ERROR: pftm NOT on surface dataset'//errMsg(sourcefile, __LINE__)) - ! Check if fsurdat grid is "close" to fatmlndfrc grid, exit if lats/lon > 0.001 + ! Cmopare surfdat_domain attributes to ldomain attributes call check_var(ncid=ncid, varname='xc', readvar=readvar) if (readvar) then @@ -387,7 +173,7 @@ subroutine surfrd_get_data (begg, endg, ldomain, lfsurdat, actual_numcft) 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 + write(iulog,*)' ERROR: surfdata_domain/ldomain lon/lat mismatch error', rmaxlon,rmaxlat call endrun(msg=errMsg(sourcefile, __LINE__)) end if @@ -512,8 +298,8 @@ subroutine surfrd_special(begg, endg, ncid, ns) ! as soil color and percent sand and clay ! ! !USES: - use clm_varpar , only : maxpatch_glcmec, nlevurb - use landunit_varcon , only : isturb_MIN, isturb_MAX, istdlak, istwet, istice_mec + use clm_varpar , only : maxpatch_glc, nlevurb + use landunit_varcon , only : isturb_MIN, isturb_MAX, istdlak, istwet, istice use clm_instur , only : wt_lunit, urban_valid, wt_glc_mec, topo_glc_mec use UrbanParamsType , only : CheckUrban ! @@ -523,24 +309,24 @@ subroutine surfrd_special(begg, endg, ncid, ns) 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 :: n,nl,nurb,g ! indices + integer :: dimid,varid ! netCDF id's + real(r8) :: nlevsoidata(nlevsoifl) + logical :: found ! temporary for error check + integer :: nindx ! temporary for error check + integer :: ier ! error status + logical :: readvar + real(r8),pointer :: pctgla(:) ! percent of grid cell is glacier + real(r8),pointer :: pctlak(:) ! percent of grid cell is lake + real(r8),pointer :: pctwet(:) ! percent of grid cell is wetland + real(r8),pointer :: pcturb(:,:) ! percent of grid cell is urbanized integer ,pointer :: urban_region_id(:) - real(r8),pointer :: pcturb_tot(:) ! percent of grid cell is urban (sum over density classes) - real(r8),pointer :: pctspec(:) ! percent of spec lunits wrt gcell - integer :: dens_index ! urban density index - character(len=32) :: subname = 'surfrd_special' ! subroutine name - real(r8) closelat,closelon + 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 + real(r8) :: closelat,closelon integer, parameter :: urban_invalid_region = 0 ! urban_region_id indicating invalid point + character(len=32) :: subname = 'surfrd_special' ! subroutine name !----------------------------------------------------------------------- allocate(pctgla(begg:endg)) @@ -602,8 +388,8 @@ subroutine surfrd_special(begg, endg, ncid, ns) ! Read glacier info - call check_dim_size(ncid, 'nglcec', maxpatch_glcmec ) - call check_dim_size(ncid, 'nglcecp1', maxpatch_glcmec+1 ) + call check_dim_size(ncid, 'nglcec', maxpatch_glc ) + call check_dim_size(ncid, 'nglcecp1', maxpatch_glc+1 ) call ncd_io(ncid=ncid, varname='PCT_GLC_MEC', flag='read', data=wt_glc_mec, & dim1name=grlnd, readvar=readvar) @@ -644,7 +430,7 @@ subroutine surfrd_special(begg, endg, ncid, ns) wt_lunit(nl,istwet) = pctwet(nl)/100._r8 - wt_lunit(nl,istice_mec) = pctgla(nl)/100._r8 + wt_lunit(nl,istice) = pctgla(nl)/100._r8 do n = isturb_MIN, isturb_MAX dens_index = n - isturb_MIN + 1 diff --git a/src/main/surfrdUtilsMod.F90 b/src/main/surfrdUtilsMod.F90 index 938f022d91..b48d8cbf74 100644 --- a/src/main/surfrdUtilsMod.F90 +++ b/src/main/surfrdUtilsMod.F90 @@ -160,7 +160,7 @@ subroutine collapse_individual_lunits(wt_lunit, begg, endg, toosmall_soil, & ! Keep landunits above the user-defined thresholds and remove the rest ! ! !USES: - use landunit_varcon, only: max_lunit, istsoil, istcrop, istice_mec, & + use landunit_varcon, only: max_lunit, istsoil, istcrop, istice, & istdlak, istwet, isturb_tbd, isturb_hd, & isturb_md ! @@ -196,7 +196,7 @@ subroutine collapse_individual_lunits(wt_lunit, begg, endg, toosmall_soil, & ! Copy the user-defined percent thresholds into array of fractions toosmall(istsoil) = toosmall_soil / 100._r8 toosmall(istcrop) = toosmall_crop / 100._r8 - toosmall(istice_mec) = toosmall_glacier / 100._r8 + toosmall(istice) = toosmall_glacier / 100._r8 toosmall(istdlak) = toosmall_lake / 100._r8 toosmall(istwet) = toosmall_wetland / 100._r8 toosmall(isturb_tbd) = toosmall_urban / 100._r8 diff --git a/src/main/test/atm2lnd_test/test_partition_precip.pf b/src/main/test/atm2lnd_test/test_partition_precip.pf index 878bdac4f6..c0d9065007 100644 --- a/src/main/test/atm2lnd_test/test_partition_precip.pf +++ b/src/main/test/atm2lnd_test/test_partition_precip.pf @@ -9,7 +9,7 @@ module test_partition_precip use unittestSubgridMod use unittestSimpleSubgridSetupsMod use unittestArrayMod - use landunit_varcon, only : istice_mec + use landunit_varcon, only : istice 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 @@ -178,7 +178,7 @@ contains call unittest_subgrid_setup_start() call unittest_add_gridcell() - call create_landunit_ncols(ltype = istice_mec, lweight = 1._r8, & + call create_landunit_ncols(ltype = istice, lweight = 1._r8, & ctypes = [1], cweights = [1._r8]) call unittest_subgrid_setup_end() diff --git a/src/main/test/clm_glclnd_test/test_clm_glclnd.pf b/src/main/test/clm_glclnd_test/test_clm_glclnd.pf index 03d60684af..e02acc3990 100644 --- a/src/main/test/clm_glclnd_test/test_clm_glclnd.pf +++ b/src/main/test/clm_glclnd_test/test_clm_glclnd.pf @@ -6,7 +6,7 @@ module test_clm_glclnd use unittestSubgridMod use shr_kind_mod, only : r8 => shr_kind_r8 use lnd2glcMod - use landunit_varcon, only : istsoil, istice_mec + use landunit_varcon, only : istsoil, istice implicit none save @@ -29,7 +29,7 @@ contains 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_add_landunit(my_gi=gi, ltype=istice, wtgcell=1.0_r8) call unittest_subgrid_setup_end() @assertEqual(1.0_r8, bareland_normalization(c_soil)) @@ -47,7 +47,7 @@ contains 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_add_landunit(my_gi=gi, ltype=istice, wtgcell=0.6_r8) call unittest_subgrid_setup_end() @assertEqual(0.75_r8, bareland_normalization(c_soil), tolerance=tol) @@ -65,7 +65,7 @@ contains 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_add_landunit(my_gi=gi, ltype=istice, wtgcell=0.6_r8) call unittest_subgrid_setup_end() @assertEqual(1.0_r8, bareland_normalization(c_soil)) diff --git a/src/main/test/glcBehavior_test/test_glcBehavior.pf b/src/main/test/glcBehavior_test/test_glcBehavior.pf index 90f12013a9..d57da25610 100644 --- a/src/main/test/glcBehavior_test/test_glcBehavior.pf +++ b/src/main/test/glcBehavior_test/test_glcBehavior.pf @@ -8,8 +8,8 @@ module test_glcBehavior use unittestSubgridMod use unittestSimpleSubgridSetupsMod use unittestArrayMod - use column_varcon, only : col_itype_to_icemec_class, icemec_class_to_col_itype - use landunit_varcon, only : istice_mec + use column_varcon, only : col_itype_to_ice_class, ice_class_to_col_itype + use landunit_varcon, only : istice use glcBehaviorMod, only : glc_behavior_type use ColumnType, only : col use unittestGlcMec @@ -217,19 +217,19 @@ contains real(r8), allocatable :: topo_col(:) call setup_elevation_classes(glc_nec, topomax) - call setup_single_icemec_column(elev_class = 1) + call setup_single_ice_column(elev_class = 1) glc_behavior = create_glc_behavior_all_collapse() col%type_is_dynamic(:) = .true. topo_col = col_array(new_topo) call glc_behavior%update_glc_classes(bounds, topo_col) - @assertEqual(new_elev_class, col_itype_to_icemec_class(col%itype(bounds%begc))) + @assertEqual(new_elev_class, col_itype_to_ice_class(col%itype(bounds%begc))) end subroutine update_glc_classes_basic @Test - subroutine update_glc_classes_non_icemec(this) - ! A column that is not ice_mec should remain unchanged + subroutine update_glc_classes_non_ice(this) + ! A column that is not ice should remain unchanged class(TestGlcBehavior), intent(inout) :: this type(glc_behavior_type) :: glc_behavior real(r8), parameter :: new_topo = 15._r8 @@ -245,7 +245,7 @@ contains call glc_behavior%update_glc_classes(bounds, topo_col) @assertEqual(coltype_orig, col%itype(bounds%begc)) - end subroutine update_glc_classes_non_icemec + end subroutine update_glc_classes_non_ice @Test subroutine have_dynamic_type(this) @@ -261,24 +261,24 @@ contains call setup_elevation_classes(3, [0._r8, 1._r8, 2._r8, 3._r8]) - ! Create 3 grid cells, all with one landunit of type istice_mec. The first and third + ! Create 3 grid cells, all with one landunit of type istice. The first and third ! will have multiple elevation classes; the second will have a single elevation class ! at the atmosphere's topographic height. All columns have 2 patches (which is not - ! typical for istice_mec, but tests the code better). + ! typical for istice, but tests the code better). call unittest_subgrid_setup_start() call unittest_add_gridcell() - call create_landunit_ncols(ltype = istice_mec, lweight = 1._r8, & - ctypes = [icemec_class_to_col_itype(1), icemec_class_to_col_itype(2)], & + call create_landunit_ncols(ltype = istice, lweight = 1._r8, & + ctypes = [ice_class_to_col_itype(1), ice_class_to_col_itype(2)], & cweights = [0.5_r8, 0.5_r8], & npatches = 2) call unittest_add_gridcell() - call create_landunit_ncols(ltype = istice_mec, lweight = 1._r8, & - ctypes = [icemec_class_to_col_itype(2)], & + call create_landunit_ncols(ltype = istice, lweight = 1._r8, & + ctypes = [ice_class_to_col_itype(2)], & cweights = [1._r8], & npatches = 2) call unittest_add_gridcell() - call create_landunit_ncols(ltype = istice_mec, lweight = 1._r8, & - ctypes = [icemec_class_to_col_itype(1), icemec_class_to_col_itype(2)], & + call create_landunit_ncols(ltype = istice, lweight = 1._r8, & + ctypes = [ice_class_to_col_itype(1), ice_class_to_col_itype(2)], & cweights = [0.5_r8, 0.5_r8], & npatches = 2) call unittest_subgrid_setup_end() diff --git a/src/main/test/surfrdUtils_test/test_surfrdUtils.pf b/src/main/test/surfrdUtils_test/test_surfrdUtils.pf index 6a0c2cdf85..065dbc9b39 100644 --- a/src/main/test/surfrdUtils_test/test_surfrdUtils.pf +++ b/src/main/test/surfrdUtils_test/test_surfrdUtils.pf @@ -50,7 +50,7 @@ contains ! The same test subsequently calls collapse_individual_lunits. use pftconMod, only: pftcon use clm_instur, only: wt_lunit - use landunit_varcon, only: max_lunit, istsoil, istcrop, istice_mec, & + use landunit_varcon, only: max_lunit, istsoil, istcrop, istice, & istdlak, istwet, isturb_tbd, isturb_hd, & isturb_md @@ -83,7 +83,7 @@ contains ! these assignments have no other significance. wt_lunit(begg:,istsoil) = (/ input_val(4), input_val(6), input_val(5)/) wt_lunit(begg:,istcrop) = (/ input_val(7), input_val(9), input_val(9)/) - wt_lunit(begg:,istice_mec) = (/ input_val(6), input_val(9), input_val(6)/) + wt_lunit(begg:,istice) = (/ input_val(6), input_val(9), input_val(6)/) wt_lunit(begg:,istdlak) = (/ input_val(1), input_val(9), input_val(9)/) wt_lunit(begg:,istwet) = (/ input_val(3), input_val(9), input_val(9)/) wt_lunit(begg:,isturb_tbd) = (/ input_val(9), input_val(2), input_val(2)/) @@ -153,7 +153,7 @@ contains ! - toosmall_* = 100._r8 . Keep only the dominant landunit per gridcell use pftconMod, only: pftcon use clm_instur, only: wt_lunit - use landunit_varcon, only: max_lunit, istsoil, istcrop, istice_mec, & + use landunit_varcon, only: max_lunit, istsoil, istcrop, istice, & istdlak, istwet, isturb_tbd, isturb_hd, & isturb_md @@ -193,7 +193,7 @@ contains ! column still summed to 100. wt_lunit(begg:,istsoil) = (/ input_value(1), input_value(8), input_value(4)/) wt_lunit(begg:,istcrop) = (/ input_value(2), input_value(7), input_value(5)/) - wt_lunit(begg:,istice_mec) = (/ input_value(3), input_value(6), input_value(6)/) + wt_lunit(begg:,istice) = (/ input_value(3), input_value(6), input_value(6)/) wt_lunit(begg:,istdlak) = (/ input_value(4), input_value(5), input_value(7)/) wt_lunit(begg:,istwet) = (/ input_value(5), input_value(4), input_value(8)/) wt_lunit(begg:,isturb_tbd) = (/ input_value(6), input_value(3), input_value(1)/) @@ -344,7 +344,7 @@ contains ! need to be collapsed. use pftconMod, only: pftcon use clm_instur, only: wt_lunit - use landunit_varcon, only: max_lunit, istsoil, istcrop, istice_mec, & + use landunit_varcon, only: max_lunit, istsoil, istcrop, istice, & istdlak, istwet, isturb_tbd, isturb_hd, & isturb_md @@ -375,7 +375,7 @@ contains ! these assignments have no other significance. wt_lunit(begg:,istsoil) = (/ input_value(4), input_value(5), input_value(4)/) wt_lunit(begg:,istcrop) = (/ input_value(7), input_value(7), input_value(7)/) - wt_lunit(begg:,istice_mec) = (/ input_value(6), input_value(6), input_value(2)/) + wt_lunit(begg:,istice) = (/ input_value(6), input_value(6), input_value(2)/) wt_lunit(begg:,istdlak) = (/ input_value(1), input_value(3), input_value(6)/) wt_lunit(begg:,istwet) = (/ input_value(3), input_value(1), input_value(9)/) wt_lunit(begg:,isturb_tbd) = (/ input_value(9), input_value(8), input_value(2)/) @@ -392,7 +392,7 @@ contains expctd(1) = input_value(1) / input_value(1) expctd(2) = input_value(2) / input_value(2) wt_expected(begg:,:) = 0._r8 ! initialize - wt_expected(begg:,istice_mec) = (/ 0._r8, 0._r8, expctd(2) /) + wt_expected(begg:,istice) = (/ 0._r8, 0._r8, expctd(2) /) wt_expected(begg:,istdlak) = (/ expctd(1), 0._r8, 0._r8 /) wt_expected(begg:,istwet) = (/ 0._r8, expctd(1), 0._r8 /) else if (test == test_n_dom_is_2) then @@ -400,7 +400,7 @@ contains expctd(2) = input_value(3) / (input_value(1) + input_value(3)) expctd(3) = input_value(2) / (input_value(2) + input_value(2)) wt_expected(begg:,:) = 0._r8 ! initialize - wt_expected(begg:,istice_mec) = (/ 0._r8, 0._r8, expctd(3) /) + wt_expected(begg:,istice) = (/ 0._r8, 0._r8, expctd(3) /) wt_expected(begg:,istdlak) = (/ expctd(1), expctd(2), 0._r8 /) wt_expected(begg:,istwet) = (/ expctd(2), expctd(1), 0._r8 /) wt_expected(begg:,isturb_tbd) = (/ 0._r8, 0._r8, expctd(3) /) @@ -425,7 +425,7 @@ contains (input_value(2) + input_value(2) + input_value(4)) wt_expected(begg:,:) = 0._r8 ! initialize wt_expected(begg:,istsoil) = (/ expctd(3), expctd(6), expctd(9) /) - wt_expected(begg:,istice_mec) = (/ 0._r8, 0._r8, expctd(8) /) + wt_expected(begg:,istice) = (/ 0._r8, 0._r8, expctd(8) /) wt_expected(begg:,istdlak) = (/ expctd(1), expctd(5), 0._r8 /) wt_expected(begg:,istwet) = (/ expctd(2), expctd(4), 0._r8 /) wt_expected(begg:,isturb_tbd) = (/ 0._r8, 0._r8, expctd(7) /) diff --git a/src/main/test/topo_test/test_topo.pf b/src/main/test/topo_test/test_topo.pf index b89ee72db8..28a46b474d 100644 --- a/src/main/test/topo_test/test_topo.pf +++ b/src/main/test/topo_test/test_topo.pf @@ -11,14 +11,14 @@ module test_topo use unittestArrayMod use filterColMod use clm_instur, only : topo_glc_mec - use clm_varpar, only : maxpatch_glcmec + use clm_varpar, only : maxpatch_glc use clm_varctl, only : glc_do_dynglacier - use landunit_varcon, only : istice_mec + use landunit_varcon, only : istice use glc2lndMod, only : glc2lnd_type use glcBehaviorMod, only : glc_behavior_type use unittestFilterBuilderMod use ColumnType, only : col - use column_varcon, only : col_itype_to_icemec_class + use column_varcon, only : col_itype_to_ice_class use domainMod, only : ldomain implicit none @@ -137,13 +137,13 @@ contains real(r8), allocatable :: glc_topo_grc(:,:) ! [gridcell, elevclass] real(r8), allocatable :: atm_topo(:) - type(filter_col_type) :: filter_icemecc + type(filter_col_type) :: filter_icec allocate(ldomain%frac(bounds%begg:bounds%endg)) this%ldomain_frac_allocated = .true. ldomain%frac(bounds%begg:bounds%endg) = 1._r8 - allocate(glc_topo_grc(bounds%begg:bounds%endg, 0:maxpatch_glcmec)) + allocate(glc_topo_grc(bounds%begg:bounds%endg, 0:maxpatch_glc)) if (present(glc_topo)) then glc_topo_grc(:,:) = glc_topo else @@ -154,7 +154,7 @@ contains topo_grc = glc_topo_grc, & icemask_grc=icemask_grc) - filter_icemecc = col_filter_from_ltypes(bounds, [istice_mec], include_inactive = .false.) + filter_icec = col_filter_from_ltypes(bounds, [istice], include_inactive = .false.) if (present(atm_topo_grc)) then atm_topo = atm_topo_grc @@ -162,7 +162,7 @@ contains atm_topo = grc_array(atm_topo_default) end if - call this%topo%UpdateTopo(bounds, filter_icemecc%num, filter_icemecc%indices, & + call this%topo%UpdateTopo(bounds, filter_icec%num, filter_icec%indices, & this%glc2lnd_inst, glc_behavior, atm_topo = atm_topo) end subroutine do_UpdateTopo @@ -212,7 +212,7 @@ contains type(filter_col_type) :: filter type(filter_col_type) :: expected_filter - call setup_single_icemec_column(elev_class = 1) + call setup_single_ice_column(elev_class = 1) expected_filter = col_filter_from_index_array(bounds, [bounds%begc]) call this%topo%Init(bounds) @@ -228,7 +228,7 @@ contains type(filter_col_type) :: filter type(filter_col_type) :: expected_filter - call setup_single_icemec_column(elev_class = 1) + call setup_single_ice_column(elev_class = 1) glc_behavior = create_glc_behavior_all_multiple() expected_filter = col_filter_from_index_array(bounds, [bounds%begc]) @@ -246,7 +246,7 @@ contains type(filter_col_type) :: filter type(filter_col_type) :: expected_filter - call setup_single_icemec_column(elev_class = 1) + call setup_single_ice_column(elev_class = 1) glc_behavior = create_glc_behavior_all_collapse() expected_filter = col_filter_empty(bounds) @@ -306,7 +306,7 @@ contains real(r8), parameter :: atm_topo = 23._r8 real(r8), parameter :: glc_topo = 27._r8 - call setup_single_icemec_column(elev_class = 1) + call setup_single_ice_column(elev_class = 1) glc_behavior = create_glc_behavior_all_virtual() topo_glc_mec(:,:) = topo_orig @@ -328,7 +328,7 @@ contains ! our column should get set to this: real(r8), parameter :: glc_topo = 27._r8 - call setup_single_icemec_column(elev_class = 1) + call setup_single_ice_column(elev_class = 1) glc_behavior = create_glc_behavior_all_virtual() topo_glc_mec(:,:) = topo_orig @@ -350,7 +350,7 @@ contains ! our column should get set to this: real(r8), parameter :: atm_topo = 23._r8 - call setup_single_icemec_column(elev_class = 1) + call setup_single_ice_column(elev_class = 1) glc_behavior = create_glc_behavior_all_collapse() topo_glc_mec(:,:) = topo_orig @@ -373,7 +373,7 @@ contains ! our column should get set to this: real(r8), parameter :: atm_topo = 23._r8 - call setup_single_icemec_column(elev_class = 1) + call setup_single_ice_column(elev_class = 1) glc_behavior = create_glc_behavior_all_collapse() topo_glc_mec(:,:) = topo_orig @@ -382,7 +382,7 @@ contains atm_topo_grc = grc_array(atm_topo), & glc_topo = glc_topo) - new_elev_class = col_itype_to_icemec_class(col%itype(bounds%begc)) + new_elev_class = col_itype_to_ice_class(col%itype(bounds%begc)) @assertEqual(3, new_elev_class) end subroutine elevClass_changes_for_singleAtAtmTopo diff --git a/src/unit_test_shr/unittestGlcMec.F90 b/src/unit_test_shr/unittestGlcMec.F90 index 4ed1c497f9..45f97da2bc 100644 --- a/src/unit_test_shr/unittestGlcMec.F90 +++ b/src/unit_test_shr/unittestGlcMec.F90 @@ -1,15 +1,15 @@ module unittestGlcMec ! This module contains routines that assist unit tests working with glc_mec - ! (istice_mec) landunits. + ! (istice) landunits. use shr_kind_mod , only : r8 => shr_kind_r8 use unittestSubgridMod use unittestSimpleSubgridSetupsMod - use landunit_varcon, only : istice_mec - use column_varcon, only : icemec_class_to_col_itype + use landunit_varcon, only : istice + use column_varcon, only : ice_class_to_col_itype use glc_elevclass_mod, only : glc_elevclass_init, glc_elevclass_clean - use clm_varpar, only : maxpatch_glcmec + use clm_varpar, only : maxpatch_glc implicit none private @@ -24,8 +24,8 @@ module unittestGlcMec public :: teardown_elevation_classes ! Do all subgrid setup needed for setting up a grid with one grid cell with a single - ! icemec column. - public :: setup_single_icemec_column + ! ice column. + public :: setup_single_ice_column contains @@ -37,7 +37,7 @@ subroutine setup_elevation_classes(glc_nec, topomax) real(r8), intent(in) :: topomax(:) ! should be size glc_nec+1 call glc_elevclass_init(glc_nec, topomax) - maxpatch_glcmec = glc_nec + maxpatch_glc = glc_nec end subroutine setup_elevation_classes subroutine teardown_elevation_classes() @@ -47,22 +47,22 @@ subroutine teardown_elevation_classes() ! setup_elevation_classes. call glc_elevclass_clean() - maxpatch_glcmec = 0 + maxpatch_glc = 0 end subroutine teardown_elevation_classes - subroutine setup_single_icemec_column(elev_class) - ! Create a grid cell with a single icemec column. + subroutine setup_single_ice_column(elev_class) + ! Create a grid cell with a single ice column. ! ! setup_elevation_classes must already have been called. integer, intent(in) :: elev_class call unittest_subgrid_setup_start() call unittest_add_gridcell() - call create_landunit_ncols(ltype=istice_mec, lweight=1.0_r8, & - ctypes=[icemec_class_to_col_itype(elev_class)], cweights=[1.0_r8]) + call create_landunit_ncols(ltype=istice, lweight=1.0_r8, & + ctypes=[ice_class_to_col_itype(elev_class)], cweights=[1.0_r8]) call unittest_subgrid_setup_end() - end subroutine setup_single_icemec_column + end subroutine setup_single_ice_column end module unittestGlcMec diff --git a/src/unit_test_shr/unittestSubgridMod.F90 b/src/unit_test_shr/unittestSubgridMod.F90 index 486957b655..2a02815614 100644 --- a/src/unit_test_shr/unittestSubgridMod.F90 +++ b/src/unit_test_shr/unittestSubgridMod.F90 @@ -12,7 +12,7 @@ module unittestSubgridMod ! 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 + ! Example: To add a single grid cell, with two landunits (nat. veg. and ice), with a ! single column on the nat veg landunit, the following can be done: ! ! call unittest_subgrid_setup_start() @@ -20,14 +20,14 @@ module unittestSubgridMod ! 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_add_landunit(my_gi=gi, ltype=istice, 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 + ! to the soil landunit, and no columns or patches were added to the ice ! landunit. This is because this extra level of detail wasn't needed for this ! particular unit test. This omission is perfectly acceptable. ! diff --git a/src/unit_test_stubs/main/histFileMod_stub.F90 b/src/unit_test_stubs/main/histFileMod_stub.F90 index 0b261dc55e..fb7f68a7d1 100644 --- a/src/unit_test_stubs/main/histFileMod_stub.F90 +++ b/src/unit_test_stubs/main/histFileMod_stub.F90 @@ -23,7 +23,7 @@ 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) + set_noglc, 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 @@ -39,7 +39,7 @@ subroutine hist_addfld1d (fname, units, avgflag, long_name, type1d_out, & 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_noglc ! value to set non-glacier 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 diff --git a/src/utils/clm_time_manager.F90 b/src/utils/clm_time_manager.F90 index 9ad956ebc8..3980ddc775 100644 --- a/src/utils/clm_time_manager.F90 +++ b/src/utils/clm_time_manager.F90 @@ -43,7 +43,6 @@ module clm_time_manager get_rest_date, &! return the date from the restart file get_local_timestep_time, &! return the local time for the input longitude to the nearest time-step get_local_time, &! return the local time for the input longitude - 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) @@ -108,10 +107,6 @@ module clm_time_manager logical, save :: tm_first_restart_step = .false. ! true for first step of a restart or branch run logical, save :: tm_perp_calendar = .false. ! true when using perpetual calendar logical, save :: timemgr_set = .false. ! true when timemgr initialized - ! - ! Next short-wave radiation calendar day - ! - real(r8) :: nextsw_cday = uninit_r8 ! calday from clock of next radiation computation ! ! The time-step number of startup or last Data Assimulation (DA) restart or pause @@ -1417,21 +1412,6 @@ logical function is_near_local_noon( londeg, deltasec ) !--------------------------------------------------------------------------------- end function is_near_local_noon - !========================================================================================= - - 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() @@ -1800,8 +1780,6 @@ subroutine timemgr_reset() tm_perp_calendar = .false. timemgr_set = .false. - 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. diff --git a/test/tools/README b/test/tools/README index 4929144b20..8972894527 100644 --- a/test/tools/README +++ b/test/tools/README @@ -13,7 +13,7 @@ To use... on cheyenne -qcmd -l walltime=06:00:00 -- ./test_driver.sh -i >& run.out & +qcmd -l select=mem=109GB -l walltime=06:00:00 -- ./test_driver.sh -i >& run.out & Intended for use on NCAR machines cheyenne, geyser (DAV) and hobart. diff --git a/test/tools/nl_files/mkmapdata_i1x1_brazil b/test/tools/nl_files/mkmapdata_i1x1_brazil new file mode 100644 index 0000000000..879ffa6d47 --- /dev/null +++ b/test/tools/nl_files/mkmapdata_i1x1_brazil @@ -0,0 +1 @@ +-t regional -r 1x1_brazil diff --git a/test/tools/nl_files/mkmapdata_if10 b/test/tools/nl_files/mkmapdata_if10 index 1c30796e2e..c3218edc1c 100644 --- a/test/tools/nl_files/mkmapdata_if10 +++ b/test/tools/nl_files/mkmapdata_if10 @@ -1 +1 @@ --t regional -r 10x15 +-r 10x15 diff --git a/test/tools/test_driver.sh b/test/tools/test_driver.sh index 0cd322b9d2..28ecb07072 100755 --- a/test/tools/test_driver.sh +++ b/test/tools/test_driver.sh @@ -78,6 +78,7 @@ export MACH_WORKSPACE="/glade/scratch" export CPRNC_EXE="$CESMDATAROOT/tools/cime/tools/cprnc/cprnc.cheyenne" dataroot="$CESMDATAROOT" export TOOLSLIBS="" +export REGRID_PROC=1 export TOOLS_CONF_STRING="--mpilib mpi-serial" diff --git a/test/tools/tests_pretag_cheyenne_nompi b/test/tools/tests_pretag_cheyenne_nompi index b80d9a78c1..3bdeef5deb 100644 --- a/test/tools/tests_pretag_cheyenne_nompi +++ b/test/tools/tests_pretag_cheyenne_nompi @@ -1,3 +1,4 @@ +smi79 bli79 smc#4 blc#4 sme14 ble14 sme@4 ble@4 diff --git a/tools/mkmapdata/mkmapdata.sh b/tools/mkmapdata/mkmapdata.sh index d0691a9817..0ff7e805b8 100755 --- a/tools/mkmapdata/mkmapdata.sh +++ b/tools/mkmapdata/mkmapdata.sh @@ -14,6 +14,7 @@ # -t Output type, supported values are [regional, global] # -r Output resolution # -b use batch mode (not default) +# -i High resolution mode (Only used with -f) # -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 @@ -68,6 +69,8 @@ usage() { 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 directly to the batch system" + echo "[-i|--hires]" + echo " Output maps are high resolution and large file support should be used" echo "[-l|--list]" echo " List mapping files required (use check_input_data to get them)" echo " also writes data to $outfilelist" @@ -137,6 +140,7 @@ list="no" outgrid="" gridfile="default" fast="no" +netcdfout="none" while [ $# -gt 0 ]; do case $1 in @@ -152,6 +156,9 @@ while [ $# -gt 0 ]; do --fast) fast="YES" ;; + -i|--hires) + netcdfout="64bit_offset" + ;; -l|--list) debug="YES" list="YES" @@ -202,12 +209,11 @@ if [ "$gridfile" != "default" ]; then 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" + # For now, maked the assumption about user-specified grids -- + # that they are SCRIP format. In the future we may want to + # provide a command-line options to allow the user to + # override that default. + DST_LRGFIL=$netcdfout DST_TYPE="SCRIP" else if [ "$res" = "default" ]; then @@ -344,8 +350,9 @@ case $hostname in fi esmfvers=7.1.0r intelvers=18.0.5 # Could also use intel/19.0.2 EBK 10/4/2019 - module load esmf_libs/$esmfvers + module purge module load intel/$intelvers + module load esmf_libs/$esmfvers module load ncl module load nco