diff --git a/cime_config/buildexe b/cime_config/buildexe new file mode 100755 index 00000000..46411bcb --- /dev/null +++ b/cime_config/buildexe @@ -0,0 +1,70 @@ +#!/usr/bin/env python + +""" +build model executable +""" + +import sys, os + +_CIMEROOT = os.path.join(os.path.dirname(os.path.abspath(__file__)), "..","..","..","cime") +sys.path.append(os.path.join(_CIMEROOT, "scripts", "Tools")) + +from standard_script_setup import * +from CIME.buildlib import parse_input +from CIME.build import get_standard_makefile_args +from CIME.case import Case +from CIME.utils import expect, run_cmd + +logger = logging.getLogger(__name__) + +############################################################################### +def _main_func(): +############################################################################### + + caseroot, _, _ = parse_input(sys.argv) + + logger.info("Building a single executable version of target coupled model") + + with Case(caseroot) as case: + casetools = case.get_value("CASETOOLS") + cimeroot = case.get_value("CIMEROOT") + exeroot = case.get_value("EXEROOT") + gmake = case.get_value("GMAKE") + gmake_j = case.get_value("GMAKE_J") + model = case.get_value("MODEL") + num_esp = case.get_value("NUM_COMP_INST_ESP") + ocn_model = case.get_value("COMP_OCN") + atm_model = case.get_value("COMP_ATM") + comp_cpl = case.get_value("COMP_ROOT_DIR_CPL") + gmake_args = get_standard_makefile_args(case) + + if ocn_model == 'mom' or atm_model == "fv3gfs": + gmake_args += "USE_FMS=TRUE" + + expect((num_esp is None) or (int(num_esp) == 1), "ESP component restricted to one instance") + + with open('Filepath', 'w') as out: + out.write(os.path.join(caseroot, "SourceMods", "src.drv") + "\n") + out.write(os.path.join(comp_cpl, "src", "drivers", "cime") + "\n") + out.write(os.path.join(comp_cpl, "src", "exch_flds") + "\n") + out.write(os.path.join(comp_cpl, "src", "mediator") + "\n") + + # build model executable + + makefile = os.path.join(casetools, "Makefile") + exename = os.path.join(exeroot, model + ".exe") + # always relink + if os.path.isfile(exename): + os.remove(exename) + + cmd = "{} exec_se -j {} EXEC_SE={} MODEL=driver {} -f {} "\ + .format(gmake, gmake_j, exename, gmake_args, makefile) + + rc, out, err = run_cmd(cmd) + expect(rc==0,"Command {} failed rc={}\nout={}\nerr={}".format(cmd,rc,out,err)) + logger.info(out) + +############################################################################### + +if __name__ == "__main__": + _main_func() diff --git a/cime_config/buildnml b/cime_config/buildnml new file mode 100755 index 00000000..92ad983c --- /dev/null +++ b/cime_config/buildnml @@ -0,0 +1,558 @@ +#!/usr/bin/env python +"""Namelist creator for CIME's driver. +""" +# Typically ignore this. +# pylint: disable=invalid-name + +# Disable these because this is our standard setup +# pylint: disable=wildcard-import,unused-wildcard-import,wrong-import-position + +import os, shutil, sys, glob, itertools + +_CIMEROOT = os.path.join(os.path.dirname(os.path.abspath(__file__)), "..","..","..","..") +sys.path.append(os.path.join(_CIMEROOT, "scripts", "Tools")) + +from standard_script_setup import * +from CIME.case import Case +from CIME.nmlgen import NamelistGenerator +from CIME.utils import expect +from CIME.utils import get_model, get_time_in_seconds, get_timestamp +from CIME.buildnml import create_namelist_infile, parse_input +from CIME.XML.files import Files + +logger = logging.getLogger(__name__) + +############################################################################### +def _create_drv_namelists(case, infile, confdir, nmlgen, files): +############################################################################### + + #-------------------------------- + # Set up config dictionary + #-------------------------------- + config = {} + cime_model = get_model() + config['cime_model'] = cime_model + config['iyear'] = case.get_value('COMPSET').split('_')[0] + config['BGC_MODE'] = case.get_value("CCSM_BGC") + config['CPL_I2O_PER_CAT'] = case.get_value('CPL_I2O_PER_CAT') + config['COMP_RUN_BARRIERS'] = case.get_value('COMP_RUN_BARRIERS') + config['DRV_THREADING'] = case.get_value('DRV_THREADING') + config['CPL_ALBAV'] = case.get_value('CPL_ALBAV') + config['CPL_EPBAL'] = case.get_value('CPL_EPBAL') + config['FLDS_WISO'] = case.get_value('FLDS_WISO') + config['BUDGETS'] = case.get_value('BUDGETS') + config['MACH'] = case.get_value('MACH') + config['MPILIB'] = case.get_value('MPILIB') + config['OS'] = case.get_value('OS') + config['glc_nec'] = 0 if case.get_value('GLC_NEC') == 0 else case.get_value('GLC_NEC') + config['single_column'] = 'true' if case.get_value('PTS_MODE') else 'false' + config['timer_level'] = 'pos' if case.get_value('TIMER_LEVEL') >= 1 else 'neg' + config['bfbflag'] = 'on' if case.get_value('BFBFLAG') else 'off' + config['continue_run'] = '.true.' if case.get_value('CONTINUE_RUN') else '.false.' + + # needed for determining the run sequence + config['COMP_ATM'] = case.get_value("COMP_ATM") + config['COMP_ICE'] = case.get_value("COMP_ICE") + config['COMP_GLC'] = case.get_value("COMP_GLC") + config['COMP_LND'] = case.get_value("COMP_LND") + config['COMP_OCN'] = case.get_value("COMP_OCN") + config['COMP_ROF'] = case.get_value("COMP_ROF") + config['COMP_WAV'] = case.get_value("COMP_WAV") + + + if case.get_value('RUN_TYPE') == 'startup': + config['run_type'] = 'startup' + elif case.get_value('RUN_TYPE') == 'hybrid': + config['run_type'] = 'startup' + elif case.get_value('RUN_TYPE') == 'branch': + config['run_type'] = 'branch' + + #---------------------------------------------------- + # Initialize namelist defaults + #---------------------------------------------------- + nmlgen.init_defaults(infile, config) + + if case.get_value('MEDIATOR_READ_RESTART'): + nmlgen.set_value('mediator_read_restart', value='.true.') + else: + nmlgen.set_value('mediator_read_restart', value='.false.') + + #-------------------------------- + # Overwrite: set brnch_retain_casename + #-------------------------------- + start_type = nmlgen.get_value('start_type') + if start_type != 'startup': + if case.get_value('CASE') == case.get_value('RUN_REFCASE'): + nmlgen.set_value('brnch_retain_casename' , value='.true.') + + # set aquaplanet if appropriate + if config['COMP_OCN'] == 'docn' and 'aqua' in case.get_value("DOCN_MODE"): + nmlgen.set_value('aqua_planet' , value='.true.') + + #-------------------------------- + # Overwrite: set component coupling frequencies + #-------------------------------- + ncpl_base_period = case.get_value('NCPL_BASE_PERIOD') + if ncpl_base_period == 'hour': + basedt = 3600 + elif ncpl_base_period == 'day': + basedt = 3600 * 24 + elif ncpl_base_period == 'year': + if case.get_value('CALENDAR') == 'NO_LEAP': + basedt = 3600 * 24 * 365 + else: + expect(False, "Invalid CALENDAR for NCPL_BASE_PERIOD %s " %ncpl_base_period) + elif ncpl_base_period == 'decade': + if case.get_value('CALENDAR') == 'NO_LEAP': + basedt = 3600 * 24 * 365 * 10 + else: + expect(False, "invalid NCPL_BASE_PERIOD NCPL_BASE_PERIOD %s " %ncpl_base_period) + else: + expect(False, "invalid NCPL_BASE_PERIOD NCPL_BASE_PERIOD %s " %ncpl_base_period) + + if basedt < 0: + expect(False, "basedt invalid overflow for NCPL_BASE_PERIOD %s " %ncpl_base_period) + + + # determine coupling intervals + comps = case.get_values("COMP_CLASSES") + mindt = basedt + coupling_times = {} + for comp in comps: + ncpl = case.get_value(comp.upper() + '_NCPL') + if ncpl is not None: + cpl_dt = basedt / int(ncpl) + totaldt = cpl_dt * int(ncpl) + if totaldt != basedt: + expect(False, " %s ncpl doesn't divide base dt evenly" %comp) + nmlgen.add_default(comp.lower() + '_cpl_dt', value=cpl_dt) + coupling_times[comp.lower() + '_cpl_dt'] = cpl_dt + mindt = min(mindt, cpl_dt) + + # sanity check + comp_atm = case.get_value("COMP_ATM") + if comp_atm is not None and comp_atm not in('datm', 'xatm', 'satm'): + atmdt = int(basedt / case.get_value('ATM_NCPL')) + expect(atmdt == mindt, 'Active atm should match shortest model timestep atmdt={} mindt={}' + .format(atmdt, mindt)) + + #-------------------------------- + # Overwrite: set start_ymd + #-------------------------------- + run_startdate = "".join(str(x) for x in case.get_value('RUN_STARTDATE').split('-')) + nmlgen.set_value('start_ymd', value=run_startdate) + + #-------------------------------- + # Overwrite: set tprof_option and tprof_n - if tprof_total is > 0 + #-------------------------------- + # This would be better handled inside the alarm logic in the driver routines. + # Here supporting only nday(s), nmonth(s), and nyear(s). + + stop_option = case.get_value('STOP_OPTION') + if 'nyear' in stop_option: + tprofoption = 'ndays' + tprofmult = 365 + elif 'nmonth' in stop_option: + tprofoption = 'ndays' + tprofmult = 30 + elif 'nday' in stop_option: + tprofoption = 'ndays' + tprofmult = 1 + else: + tprofmult = 1 + tprofoption = 'never' + + tprof_total = case.get_value('TPROF_TOTAL') + if ((tprof_total > 0) and (case.get_value('STOP_DATE') < 0) and ('ndays' in tprofoption)): + stop_n = case.get_value('STOP_N') + stopn = tprofmult * stop_n + tprofn = int(stopn / tprof_total) + if tprofn < 1: + tprofn = 1 + nmlgen.set_value('tprof_option', value=tprofoption) + nmlgen.set_value('tprof_n' , value=tprofn) + + # Set up the pause_component_list if pause is active + pauseo = case.get_value('PAUSE_OPTION') + if pauseo != 'never' and pauseo != 'none': + pausen = case.get_value('PAUSE_N') + pcl = nmlgen.get_default('pause_component_list') + nmlgen.add_default('pause_component_list', pcl) + # Check to make sure pause_component_list is valid + pcl = nmlgen.get_value('pause_component_list') + if pcl != 'none' and pcl != 'all': + pause_comps = pcl.split(':') + comp_classes = case.get_values("COMP_CLASSES") + for comp in pause_comps: + expect(comp == 'drv' or comp.upper() in comp_classes, + "Invalid PAUSE_COMPONENT_LIST, %s is not a valid component type"%comp) + # End for + # End if + # Set esp interval + if 'nstep' in pauseo: + esp_time = mindt + else: + esp_time = get_time_in_seconds(pausen, pauseo) + + nmlgen.set_value('esp_cpl_dt', value=esp_time) + # End if pause is active + + #-------------------------------- + # (1) Specify input data list file + #-------------------------------- + data_list_path = os.path.join(case.get_case_root(), "Buildconf", "cpl.input_data_list") + if os.path.exists(data_list_path): + os.remove(data_list_path) + + #-------------------------------- + # (2) Write namelist file drv_in and initial input dataset list. + #-------------------------------- + namelist_file = os.path.join(confdir, "drv_in") + drv_namelist_groups = ["papi_inparm", "pio_default_inparm", "prof_inparm"] + nmlgen.write_output_file(namelist_file, data_list_path=data_list_path, groups=drv_namelist_groups) + + #-------------------------------- + # (3) Write nuopc.runconfig file and add to input dataset list. + #-------------------------------- + + # Determine components that are not present + comp_types = ['atm','lnd','ice','ocn','rof','glc','wav','esp'] + skip_comps = [] + for item in comp_types: + # stub comps + if case.get_value("COMP_" + item.upper()) == 's' + item: + skip_comps.append(item.upper()) + # data comps + if case.get_value("COMP_" + item.upper()) == 'd' + item: + if item != 'glc': #no glc data component + if case.get_value("D" + item.upper()) == 'NULL' or case.get_value("D" + item.upper()) == 'null': + skip_comps.append(item.upper) + # xcpl_comps + if case.get_value("COMP_" + item.upper()) == 'x' + item: + if item != 'esp': #no esp xcpl component + if case.get_value(item.upper() + "_NX") == "0" and case.get_value(item.upper() + "_NY") == "0": + skip_comps.append(item.upper) + + logger.info("Writing nuopc_runseq will skip components {}".format(skip_comps)) + + nuopc_config_file = os.path.join(confdir, "nuopc.runconfig") + nmlgen.write_nuopc_config_file(nuopc_config_file, data_list_path=data_list_path, skip_comps=skip_comps) + + #-------------------------------- + # (4) Write nuopc.runseq + #-------------------------------- + _create_runseq(case, coupling_times) + + #-------------------------------- + # (5) Write drv_flds_in + #-------------------------------- + # In thte following, all values come simply from the infiles - no default values need to be added + # FIXME - do want to add the possibility that will use a user definition file for drv_flds_in + + caseroot = case.get_value('CASEROOT') + namelist_file = os.path.join(confdir, "drv_flds_in") + nmlgen.add_default('drv_flds_in_files') + drvflds_files = nmlgen.get_default('drv_flds_in_files') + infiles = [] + for drvflds_file in drvflds_files: + infile = os.path.join(caseroot, drvflds_file) + if os.path.isfile(infile): + infiles.append(infile) + + if len(infiles) != 0: + + # First read the drv_flds_in files and make sure that + # for any key there are not two conflicting values + dicts = {} + for infile in infiles: + dict_ = {} + with open(infile) as myfile: + for line in myfile: + if "=" in line and '!' not in line: + name, var = line.partition("=")[::2] + name = name.strip() + var = var.strip() + dict_[name] = var + dicts[infile] = dict_ + + for first,second in itertools.combinations(dicts.keys(),2): + compare_drv_flds_in(dicts[first], dicts[second], first, second) + + # Now create drv_flds_in + config = {} + definition_dir = os.path.dirname(files.get_value("NAMELIST_DEFINITION_FILE", attribute={"component":"drv"})) + definition_file = [os.path.join(definition_dir, "namelist_definition_drv_flds.xml")] + nmlgen = NamelistGenerator(case, definition_file, files=files) + skip_entry_loop = True + nmlgen.init_defaults(infiles, config, skip_entry_loop=skip_entry_loop) + drv_flds_in = os.path.join(caseroot, "CaseDocs", "drv_flds_in") + nmlgen.write_output_file(drv_flds_in) + +############################################################################### +def _create_runseq(case, coupling_times): +############################################################################### + + rundir = case.get_value("RUNDIR") + caseroot = case.get_value("CASEROOT") + cimeroot = case.get_value("CIMEROOT") + comp_atm = case.get_value("COMP_ATM") + comp_ice = case.get_value("COMP_ICE") + comp_glc = case.get_value("COMP_GLC") + comp_lnd = case.get_value("COMP_LND") + comp_ocn = case.get_value("COMP_OCN") + comp_rof = case.get_value("COMP_ROF") + comp_wav = case.get_value("COMP_WAV") + comp_cpl = case.get_value("COMP_ROOT_DIR_CPL") + + user_file = os.path.join(caseroot, "nuopc.runseq") + if os.path.exists(user_file): + + # Determine if there is a user run sequence file in CASEROOT, use it + shutil.copy(user_file, rundir) + shutil.copy(user_file, os.path.join(caseroot,"CaseDocs")) + logger.info("NUOPC run sequence: copying custom run sequence from case root") + + else: + + # Create a run sequence file appropriate for target compset + input_dir = os.path.join(os.path.join(comp_cpl, "cime_config")) + + if (comp_atm == 'datm' and comp_ocn == "docn" and comp_ice == 'dice' and + comp_rof == 'drof' and comp_wav == 'swav' and comp_lnd == 'slnd'): + # for A compsets + runseq_input = os.path.join(input_dir, 'nuopc_runseq_A') + + elif (comp_atm == 'satm' and comp_ocn == "socn" and comp_ice == 'sice' and + comp_rof == 'srof' and comp_wav == 'dwav' and comp_lnd == 'slnd'): + # for ADWAV compsets + runseq_input = os.path.join(input_dir, 'nuopc_runseq_ADWAV') + + elif (comp_atm == 'satm' and comp_ocn == "socn" and comp_ice == 'sice' and + comp_rof == 'srof' and comp_wav == 'swav' and comp_lnd == 'dlnd'): + # for ADLND compsets + runseq_input = os.path.join(input_dir, 'nuopc_runseq_ADLND') + + elif (comp_atm == 'xatm' and comp_ocn == "xocn" and comp_ice == 'xice' and comp_rof == 'xrof'): + # for X compsets + runseq_input = os.path.join(input_dir, 'nuopc_runseq_X') + + elif (comp_atm == 'cam' and comp_lnd == 'clm' and comp_ocn == "docn"): + # for F compsets + runseq_input = os.path.join(input_dir, 'nuopc_runseq_F') + + elif (comp_atm == 'cam' and comp_lnd == 'slnd' and comp_ice == 'sice' and comp_ocn == "docn"): + # for Q (aquaplanet) compsets + runseq_input = os.path.join(input_dir, 'nuopc_runseq_Q') + + elif ( (comp_atm == 'datm' and comp_ocn == "mom" and comp_ice == "dice") or + (comp_atm == 'datm' and comp_ocn == "mom" and comp_ice == "cice") or + (comp_atm == 'datm' and comp_ocn == "docn" and comp_ice == "cice")): + # for C, G and D compsets + runseq_input = os.path.join(input_dir, 'nuopc_runseq_C_G_D') + + elif (comp_atm == 'datm' and comp_lnd == "clm"): + # for I compsets + if (comp_rof == 'srof' and comp_glc == "sglc"): + runseq_input = os.path.join(input_dir, 'nuopc_runseq_I') + elif (comp_rof == 'mosart' and comp_glc == "sglc"): + runseq_input = os.path.join(input_dir, 'nuopc_runseq_I_mosart') + elif (comp_rof == 'mosart' and comp_glc == "glc"): + runseq_input = os.path.join(input_dir, 'nuopc_runseq_I_mosart_cism') + + elif (comp_atm == 'cam' and comp_lnd == "clm" and comp_ocn == 'mom'): + # for CESM fully coupled + if (comp_rof == 'srof' and comp_glc == "sglc"): + runseq_input = os.path.join(input_dir, 'nuopc_runseq_B') + + elif (comp_atm == 'fv3gfs' and comp_ocn == "mom" and comp_ice == 'cice'): + # for NEMS fully coupled + if case.get_value("CONTINUE_RUN") or case.get_value("MEDIATOR_READ_RESTART"): + logger.info("NUOPC run sequence: warm start (concurrent)") + runseq_input = os.path.join(input_dir, 'nuopc_runseq_NEMS.warm') + else: + logger.info("NUOPC run sequence: cold start (sequential)") + runseq_input = os.path.join(input_dir, 'nuopc_runseq_NEMS.cold') + + else: + # default + runseq_input = os.path.join(input_dir, 'nuopc_runseq_default') + + file_input = open(runseq_input, "r") + + #-------------------------------- + # Write output run sequence file + #-------------------------------- + + runseq_output = os.path.join(caseroot, 'CaseDocs', 'nuopc.runseq') + file_output = open(runseq_output, "w") + + for line in file_input.readlines(): + for key, value in coupling_times.items(): + if key in line: + line = line.replace(key, str(value)) + file_output.write(line) + file_output.close() + + # copy the file to rundir + shutil.copy(runseq_output, rundir) + +############################################################################### +def compare_drv_flds_in(first, second, infile1, infile2): +############################################################################### + sharedKeys = set(first.keys()).intersection(second.keys()) + for key in sharedKeys: + if first[key] != second[key]: + print('Key: {}, \n Value 1: {}, \n Value 2: {}'.format(key, first[key], second[key])) + expect(False, "incompatible settings in drv_flds_in from \n %s \n and \n %s" + % (infile1, infile2)) + +############################################################################### +def _create_component_modelio_namelists(confdir, case, files): +############################################################################### + + # will need to create a new namelist generator + infiles = [] + definition_dir = os.path.dirname(files.get_value("NAMELIST_DEFINITION_FILE", attribute={"component":"drv"})) + definition_file = [os.path.join(definition_dir, "namelist_definition_modelio.xml")] + + confdir = os.path.join(case.get_value("CASEBUILD"), "cplconf") + lid = os.environ["LID"] if "LID" in os.environ else get_timestamp("%y%m%d-%H%M%S") + + #if we are in multi-coupler mode the number of instances of mediator will be the max + # of any NINST_* value + maxinst = 1 + if case.get_value("MULTI_DRIVER"): + maxinst = case.get_value("NINST_MAX") + multi_driver = True + + nuopc_config_file = os.path.join(confdir, "nuopc.runconfig") + for model in case.get_values("COMP_CLASSES"): + model = model.lower() + with NamelistGenerator(case, definition_file) as nmlgen: + config = {} + config['component'] = model + entries = nmlgen.init_defaults(infiles, config, skip_entry_loop=True) + if maxinst == 1 and model != 'cpl' and not multi_driver: + inst_count = case.get_value("NINST_" + model.upper()) + else: + inst_count = maxinst + + inst_string = "" + inst_index = 1 + while inst_index <= inst_count: + # determine instance string + if inst_count > 1: + inst_string = '_{:04d}'.format(inst_index) + + # Write out just the pio_inparm to the output file + for entry in entries: + nmlgen.add_default(entry) + + if model == "cpl": + modelio_file = "med_modelio.nml" + inst_string + else: + modelio_file = model + "_modelio.nml" + inst_string + nmlgen.write_nuopc_modelio_file(os.path.join(confdir, modelio_file)) + + # Output the following to nuopc.runconfig + moddiro = case.get_value('RUNDIR') + if model == 'cpl': + logfile = 'med' + inst_string + ".log." + str(lid) + else: + logfile = model + inst_string + ".log." + str(lid) + + with open(nuopc_config_file, 'a') as outfile: + if model == 'cpl': + name = "MED" + else: + name = model.upper() + if inst_string: + outfile.write("{}_modelio{}::\n".format(name,inst_string)) + else: + outfile.write("{}_modelio::\n".format(name)) + outfile.write(" {}{}{}".format("diro = ", moddiro,"\n")) + outfile.write(" {}{}{}".format("logfile = ", logfile,"\n")) + outfile.write("::\n\n") + + inst_index = inst_index + 1 + + +############################################################################### +def buildnml(case, caseroot, component): +############################################################################### + if component != "drv": + raise AttributeError + + confdir = os.path.join(case.get_value("CASEBUILD"), "cplconf") + if not os.path.isdir(confdir): + os.makedirs(confdir) + + # NOTE: User definition *replaces* existing definition. + # TODO: Append instead of replace? + user_xml_dir = os.path.join(caseroot, "SourceMods", "src.drv") + + expect (os.path.isdir(user_xml_dir), + "user_xml_dir %s does not exist " %user_xml_dir) + + files = Files(comp_interface="nuopc") + + # TODO: to get the right attributes of COMP_ROOT_DIR_CPL in evaluating definition_file - need + # to do the following first - this needs to be changed so that the following two lines are not needed! + comp_root_dir_cpl = files.get_value( "COMP_ROOT_DIR_CPL",{"component":"drv-nuopc"}, resolved=False) + files.set_value("COMP_ROOT_DIR_CPL", comp_root_dir_cpl) + + definition_file = [files.get_value("NAMELIST_DEFINITION_FILE", {"component": "drv-nuopc"})] + fd_dir = os.path.dirname(definition_file[0]) + user_definition = os.path.join(user_xml_dir, "namelist_definition_drv.xml") + if os.path.isfile(user_definition): + definition_file = [user_definition] + + # create the namelist generator object - independent of instance + nmlgen = NamelistGenerator(case, definition_file) + + # create cplconf/namelist + infile_text = "" + + # determine infile list for nmlgen + user_nl_file = os.path.join(caseroot, "user_nl_cpl") + namelist_infile = os.path.join(confdir, "namelist_infile") + create_namelist_infile(case, user_nl_file, namelist_infile, infile_text) + infile = [namelist_infile] + + # create the files nuopc.runconfig, nuopc.runseq, drv_in and drv_flds_in + _create_drv_namelists(case, infile, confdir, nmlgen, files) + + # create the files comp_modelio.nml where comp = [atm, lnd...] + _create_component_modelio_namelists(confdir, case, files) + + # set rundir + rundir = case.get_value("RUNDIR") + + # copy nuopc.runconfig to rundir + shutil.copy(os.path.join(confdir,"drv_in"), rundir) + shutil.copy(os.path.join(confdir,"nuopc.runconfig"), rundir) + + # copy drv_flds_in to rundir + drv_flds_in = os.path.join(caseroot, "CaseDocs", "drv_flds_in") + if os.path.isfile(drv_flds_in): + shutil.copy(drv_flds_in, rundir) + + # copy all *modelio* files to rundir + for filename in glob.glob(os.path.join(confdir, "*modelio*")): + shutil.copy(filename, rundir) + + # copy fd.yaml to rundir + comp_cpl = case.get_value("COMP_ROOT_DIR_CPL") + fd_dir = os.path.join(comp_cpl, "src", "exch_flds") + filename = os.path.join(fd_dir,"fd.yaml") + shutil.copy(filename, rundir) + +############################################################################### +def _main_func(): + caseroot = parse_input(sys.argv) + + with Case(caseroot) as case: + buildnml(case, caseroot, "drv") + +if __name__ == "__main__": + _main_func() diff --git a/cime_config/config_archive.xml b/cime_config/config_archive.xml new file mode 100644 index 00000000..c8717412 --- /dev/null +++ b/cime_config/config_archive.xml @@ -0,0 +1,19 @@ + + + r + hi?\d*.*\.nc$ + unset + + rpointer$NINST_STRING.drv + $CASE.cpl$NINST_STRING.r.$DATENAME.nc + + + cpl_0001.log.5548574.chadmin1.180228-124723.gz + casename.cpl.r.1976-01-01-00000.nc + rpointer.drv_0001 + rpointer.drv + casenamenot.cpl.r.1976-01-01-00000.nc + + + + diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml new file mode 100644 index 00000000..2bdd41fd --- /dev/null +++ b/cime_config/config_component.xml @@ -0,0 +1,2536 @@ + + + + + + + + + + char + CPL,ATM,LND,ICE,OCN,ROF,GLC,WAV,ESP + env_case.xml + case_comp + List of component classes supported by this driver + + + + char + cpl + cpl + case_comp + env_case.xml + Name of coupling component + + + + + + + + + char + $CIMEROOT/config_files.xml + case_def + env_case.xml + master configuration file that specifies all relevant filenames + and directories to configure a case + + + + + + + + char + UNSET + case_def + env_case.xml + full pathname of case + + + + char + $CASEROOT/Tools + case_der + env_case.xml + Case Tools directory location (derived variable, not in namelists + + + + char + $CASEROOT/Buildconf + case_der + env_case.xml + Buildconf directory location (derived variable not in namelist) + + + + char + $CASEROOT/logs + run_desc + env_run.xml + Extra copies of the component log files will be saved here. + + + + char + $CIMEROOT/scripts + case_der + env_case.xml + Scripts root directory location (setup automatically to $CIMEROOT/scripts- DO NOT EDIT) + + + + char + UNSET + case_def + env_case.xml + full pathname of CIME source root directory + + + + char + $CIMEROOT/.. + case_def + env_case.xml + full pathname of source root directory + + + + char + $CIMEROOT/scripts/Tools + case_der + env_case.xml + Scripts root utils directory location (setup automatically to $CIMEROOT/scripts/Tools - DO NOT EDIT) + + + + + + + + char + UNSET + case_def + env_case.xml + case name + + + + char + UNSET + run_desc + env_run.xml + case description + + + + char + UNSET + case_last + env_case.xml + Component set long name (for documentation only - DO NOT EDIT) + + + + char + UNSET + build_grid + env_build.xml + Model grid - DO NOT EDIT (for experts only) + + + + char + UNSET + case_def + env_case.xml + current machine name support contact + + + + char + $ENV{USER} + case_desc + env_case.xml + case user name + + + + char + $ENV{USER} + case_desc + env_case.xml + username of user who created case + + + + + + + + char + startup,hybrid,branch + startup + run_begin_stop_restart + env_run.xml + + Determines the model run initialization type. + This setting is only important for the initial run of a production run when the + CONTINUE_RUN variable is set to FALSE. After the initial run, the CONTINUE_RUN + variable is set to TRUE, and the model restarts exactly using input + files in a case, date, and bit-for-bit continuous fashion. + Default: startup. + -- In a startup run (the default), all components are initialized + using baseline states. These baseline states are set independently by + each component and can include the use of restart files, initial + files, external observed data files, or internal initialization (i.e., + a cold start). In a startup run, the coupler sends the start date to + the components at initialization. In addition, the coupler does not + need an input data file. In a startup initialization, the ocean model + does not start until the second ocean coupling (normally the second + day). + -- In a branch run, all components are initialized using a consistent + set of restart files from a previous run (determined by the + RUN_REFCASE and RUN_REFDATE variables in env_run.xml). The case name + is generally changed for a branch run, although it does not have to + be. In a branch run, setting RUN_STARTDATE is ignored because the + model components obtain the start date from their restart datasets. + Therefore, the start date cannot be changed for a branch run. This is + the same mechanism that is used for performing a restart run (where + CONTINUE_RUN is set to TRUE in the env_run.xml) Branch runs are + typically used when sensitivity or parameter studies are required, or + when settings for history file output streams need to be modified + while still maintaining bit-for-bit reproducibility. Under this + scenario, the new case is able to produce an exact bit-for-bit restart + in the same manner as a continuation run IF no source code or + component namelist inputs are modified. All models use restart files + to perform this type of run. RUN_REFCASE and RUN_REFDATE are required + for branch runs. + To set up a branch run, locate the restart tar file or restart + directory for RUN_REFCASE and RUN_REFDATE from a previous run, then + place those files in the RUNDIR directory. + --- In a hybrid run the model is initialized as a startup, BUT uses + initialization datasets FROM A PREVIOUS case. This + is somewhat analogous to a branch run with relaxed restart + constraints. A hybrid run allows users to bring together combinations + of initial/restart files from a previous case (specified by + RUN_REFCASE) at a given model output date (specified by + RUN_REFDATE). Unlike a branch run, the starting date of a hybrid run + (specified by RUN_STARTDATE) can be modified relative to the reference + case. In a hybrid run, the model does not continue in a bit-for-bit + fashion with respect to the reference case. The resulting climate, + however, should be continuous provided that no model source code or + namelists are changed in the hybrid run. In a hybrid initialization, + the ocean model does not start until the second ocean coupling + (normally the second day), and the coupler does a cold start without + a restart file. + + + + + char + ccsm4_init + run_begin_stop_restart + env_run.xml + + Reference directory containing RUN_REFCASE data - used for hybrid or branch runs + + + + + char + case.std + run_begin_stop_restart + env_run.xml + + Reference case for hybrid or branch runs + + + + + char + 0001-01-01 + run_begin_stop_restart + env_run.xml + + Reference date for hybrid or branch runs (yyyy-mm-dd) + + + + + char + 00000 + run_begin_stop_restart + env_run.xml + + Reference time of day (seconds) for hybrid or branch runs (sssss) + + + + + logical + TRUE,FALSE + FALSE + run_begin_stop_restart + env_run.xml + + Flag for automatically prestaging the refcase restart dataset. + If TRUE, then the refcase data is prestaged into the executable directory + + + + + char + 0001-01-01 + run_begin_stop_restart + env_run.xml + + Run start date (yyyy-mm-dd). Only used for startup or hybrid runs. + + + + + integer + 0 + run_begin_stop_restart + env_run.xml + + Run start time-of-day + + + + + char + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,ifdays0,end + ndays + run_begin_stop_restart + env_run.xml + + Sets the run length along with STOP_N and STOP_DATE + + + + + integer + 5 + run_begin_stop_restart + env_run.xml + + Provides a numerical count for $STOP_OPTION. + + + + + integer + -999 + run_begin_stop_restart + env_run.xml + + Alternative date yyyymmdd date option, sets the run length with STOP_OPTION and STOP_N + negative value implies off + + + + + char + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,ifdays0,end + $STOP_OPTION + run_begin_stop_restart + env_run.xml + + sets frequency of model restart writes (same options as STOP_OPTION) + + + + + integer + $STOP_N + run_begin_stop_restart + env_run.xml + + sets model restart writes with REST_OPTION and REST_DATE + + + + + char + $STOP_DATE + run_begin_stop_restart + env_run.xml + + Alternative date in yyyymmdd format + sets model restart write date with REST_OPTION and REST_N + + + + + char + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear + never + run_begin_stop_restart + env_run.xml + + Sets the pause frequency along with PAUSE_N + + + + + integer + 0 + run_begin_stop_restart + env_run.xml + + Provides a numerical count for $PAUSE_OPTION. + + + + + logical + TRUE,FALSE + run_begin_stop_restart + env_run.xml + + Pause the model at times specified by PAUSE_OPTION and PAUSE_N. + Components 'pause' by writing a restart file. + + + FALSE + FALSE + FALSE + FALSE + FALSE + FALSE + FALSE + FALSE + + + + + char + 1 + run_begin_stop_restart + env_run.xml + + Sets periodic model barriers with BARRIER_OPTION and BARRIER_DATE for synchronization + + + + + char + -999 + run_begin_stop_restart + env_run.xml + + Alternative date in yyyymmdd format + sets periodic model barriers with BARRIER_OPTION and BARRIER_N for synchronization + + + + + logical + TRUE,FALSE + FALSE + run_begin_stop_restart + env_run.xml + + ESP component runs after driver 'pause cycle' If any component + 'pauses' (see PAUSE_OPTION, + PAUSE_N and PAUSE_ACTIVE_XXX XML variables), + the ESP component (if present) will be run to process the + component 'pause' (restart) files and set any required 'resume' + signals. If true, esp_cpl_dt and esp_cpl_offset settings are + ignored. default: false + + + + + logical + TRUE,FALSE + FALSE + run_begin_stop_restart + env_run.xml + + A setting of TRUE implies a continuation run + When you first begin a branch, hybrid or startup run, CONTINUE_RUN + must be set to FALSE. When you successfully run and get a restart + file, you will need to change CONTINUE_RUN to TRUE for the remainder + of your run. This variable determines if the run is a restart run. + Set to FALSE when initializing a startup, branch or hybrid case. + Set to TRUE when continuing a run. + + + + + logical + TRUE,FALSE + FALSE + run_begin_stop_restart + env_run.xml + + A setting of TRUE implies a continuation run for mediator only + + + + + integer + 0 + run_begin_stop_restart + env_run.xml + If RESUBMIT is greater than 0, then case will automatically resubmit + Enables the model to automatically resubmit a new run. To get + multiple runs, set RESUBMIT greater than 0, then RESUBMIT will be + decremented and the case will be resubmitted. The case will stop automatically + resubmitting when the RESUBMIT value reaches 0. + Long runs can easily outstrip supercomputer queue time limits. For + this reason, a case is usually run as a series of jobs, each + restarting where the previous finished. + + + + + logical + TRUE + run_begin_stop_restart + env_run.xml + This flag controls whether the RESUBMIT flag causes + CONTINUE_RUN to toggle from FALSE to TRUE. The default is + TRUE. This flag might be used in conjunction with COMP_RUN_BARRIERS for + timing tests. + + + + + logical + run_begin_stop_restart + FALSE + TRUE,FALSE + env_run.xml + Logical to determine whether CESM run has been submitted with the submit script or not + + + + char + + run_begin_stop_restart + env_run.xml + List of job ids for most recent case.submit + + + + + + + + logical + TRUE,FALSE + FALSE + run_data_archive + env_run.xml + Logical to turn on short term archiving. + If TRUE, short term archiving will be turned on. + + + + integer + 900 + run_data_archive + env_run.xml + system workload snapshot frequency (in seconds, if greater than 0; disabled otherwise) + + + + + + + + char + UNSET + config_batch + env_mach_specific.xml + The environment variables that will be loaded for this machine + + + + char + none + nersc_slurm,lc_slurm,moab,pbs,lsf,slurm,cobalt,cobalt_theta,none + config_batch + env_batch.xml + The batch system type to use for this machine. + + + + char + UNSET + config_batch + env_mach_specific.xml + The individual environment variable entry for config_machines + + + + char + UNSET + config_batch + env_mach_specific.xml + The limits tag + + + + char + UNSET + config_batch + env_mach_specific.xml + The individual limit variable + + + + + + + + char + + build_derived + env_build.xml + Perl 5 library directory + + + + char + + config_batch + env_case.xml + The mpi run command associated with the machine configured batch system + + + + char + UNSET + config_batch + env_case.xml + The module system type defined for this machine + + + + char + UNSET + config_batch + env_case.xml + The module initialization path for module system defined for this machine + + + + char + UNSET + config_batch + env_case.xml + The module command path for module system defined for this machine + + + + + + + + + char + + UNSET + build_def + env_build.xml + Output root directory for each machine. + Base directory for build and run directories. + + + + + char + + $CIME_OUTPUT_ROOT/$CASE/bld + build_def + env_build.xml + Case executable root directory. + (executable is $EXEROOT/$MODEL.exe, component libraries are in $EXEROOT/lib) + This is where the model builds its executable and by default runs the executable. + Note that EXEROOT needs to have enough disk space for the experimental configuration + requirements. As an example, a model run can produce more than a terabyte of + data during a 100-year run, so you should set EXEROOT to scratch or + tmp space and frequently back up the data to a long term archiving storage device + For a supported machine, EXEROOT is set in $CIMEROOT/machines/config_machines.xml. + For a userdefined machine, EXEROOT must explicitly be set it in env_build.xml. + + + + char + + USERDEFINED_required_macros + build_macros + env_build.xml + Operating system - DO NOT EDIT UNLESS for userdefined machine - ignored once Macros has been created. + + + + char + + + build_macros + env_build.xml + Machine compiler (must match one the supported compilers) + Set in $CIMEROOT/machines/config_machines.xml for each supported machine. + Must be explicitly set in env_build.xml for userdefined machine. + + + + char + + + build_def + env_build.xml + email address of person (or group) that supports the build and port for this machine (do not edit)> + + + + char + + USERDEFINED_required_macros + build_macros + env_build.xml + mpi library (must match one of the supported libraries) - + ignored once Macros has been created + Set in $CIMEROOT/machines/config_machines.xml for each supported machine. + Must be explicitly set in env_build.xml for userdefined machine. + + + + char + NO_LEAP,GREGORIAN + NO_LEAP + build_def + env_build.xml + calendar type + + + + char + nuopc + nuopc + build_def + env_build.xml + use NUOPC component interface + + + + logical + TRUE + TRUE + build_def + env_build.xml + TRUE implies using the ESMF library specified by ESMF_LIBDIR or ESMFMKFILE + + + + logical + TRUE,FALSE + FALSE + build_def + env_build.xml + TRUE implies turning on run and compile time debugging + Flag to turn on debugging for run time and compile time. + If TRUE, compile-time debugging flags are activated that you can use to verify + software robustness, such as bounds checking. + Important:: On IBM machines, floating point trapping is not activated for production + runs (i.e., non-DEBUG), due to performance penalties associated with turning on these flags. + + + + logical + TRUE,FALSE + FALSE + build_def + env_build.xml + TRUE implies always build model for openmp capability + If FALSE, component libraries are built with OpenMP capability only if + the NTHREADS_ setting for that component is greater than 1 in env_mach_pes.xml. + If TRUE, the component libraries are always built with OpenMP capability. + + + + logical + TRUE,FALSE + FALSE + build_def + env_build.xml + TRUE implies always build model for openmp capability + If FALSE, component libraries are built with OpenMP capability only if + the NTHREADS_ setting for that component is greater than 1 in env_mach_pes.xml. + If TRUE, the component libraries are always built with OpenMP capability. + + + + logical + TRUE,FALSE + FALSE + build_def + env_build.xml + TRUE implies that at least one of the components is built threaded (DO NOT EDIT) + + + + logical + TRUE,FALSE + FALSE + build_def + env_build.xml + TRUE implies linking to the PETSc library - set + automatically by XXX_USE_PETSC options (do not edit). Flag to turn + on linking to the PETSc library. Currently this is used by + CLM. This is currently only supported for certain machines. + + + + logical + TRUE,FALSE + FALSE + build_def + env_build.xml + TRUE implies linking to the Albany library - set + automatically by XXX_USE_ALBANY options (do not edit). Flag to + turn on linking to the Albany library. Currently this is used by + MPASLI. Note that Albany is a C++ library, so setting this + variable to TRUE will involve the inclusion of C++ code in the + MPASLI executable. This is currently only supported for certain + machines. + + + + logical + TRUE,FALSE + FALSE + build_def + env_build.xml + TRUE implies linking to the MOAB library + + + + logical + TRUE,FALSE + FALSE + build_def + env_build.xml + TRUE implies linking to the trilinos library - set automatically by XXX_USE_TRILINOS options (do not edit) + Flag to turn on linking to the trilinos library. Currently this is + used by CISM. Note that trilinos is a C++ library, so setting this + variable to TRUE will involve the inclusion of C++ code in the model + executable. This is currently only supported for certain machines. + + + + char + + gmake + build_def + env_run.xml + GNU make command + + + + integer + + 1 + build_def + env_run.xml + Number of processors for gmake + + + + logical + TRUE,FALSE + FALSE + build_status + env_build.xml + Status output: if TRUE, models have been built successfully. (DO NOT EDIT)> + + + + char + + 0 + build_status + env_build.xml + Status: smp status of previous build, coded string. (DO NOT EDIT) + + + + char + + 0 + build_status + env_build.xml + Status: smp status of current case, coded string (DO NOT EDIT) + + + + char + + 0 + build_status + env_build.xml + Status: ninst status of previous build, coded string. (DO NOT EDIT)> + + + + char + + 0 + build_status + env_build.xml + Status: ninst status of current case, coded string (DO NOT EDIT) + + + + integer + 0,1,2 + 0 + build_status + env_build.xml + Status: of prior build. (DO NOT EDIT) + + + + char + + $EXEROOT + build_derived + env_build.xml + case build directory (set automatically to $EXEROOT, - DO NOT EDIT) + + + + char + + $EXEROOT/lib + build_derived + env_build.xml + case lib directory (set automatically to $EXEROOT/lib - DO NOT EDIT) + + + + char + + $EXEROOT/lib/include + build_derived + env_build.xml + case lib include directory (set automatically to $EXEROOT/lib/include - DO NOT EDIT) + + + + char + + $EXEROOT + build_derived + env_build.xml + Shared library root, (set automatically to $EXEROOT - DO NOT EDIT) + + + + + + + + logical + TRUE,FALSE + TRUE + run_flags + env_run.xml + logical to diagnose model timing at the end of the run + + + + logical + TRUE,FALSE + FALSE + run_flags + env_run.xml + Enables the papi hardware counters in gptl + The papi library must be included in the build step for + this to work. + + + + char + ESMF_LOGKIND_SINGLE,ESMF_LOGKIND_MULTI,ESMF_LOGKIND_NONE + ESMF_LOGKIND_NONE + run_flags + env_run.xml + + Determines what ESMF log files (if any) are generated when + USE_ESMF_LIB is TRUE. + ESMF_LOGKIND_SINGLE: Use a single log file, combining messages from + all of the PETs. Not supported on some platforms. + ESMF_LOGKIND_MULTI: Use multiple log files -- one per PET. + ESMF_LOGKIND_NONE: Do not issue messages to a log file. + By default, no ESMF log files are generated. + + + + + logical + TRUE,FALSE + FALSE + run_flags + env_run.xml + Turns on component barriers for component timing. + This variable is for testing and debugging only and should never + be set for a production run. + + + + + integer + 0 + mach_pes_last + env_mach_pes.xml + pes or cores used relative to MAX_MPITASKS_PER_NODE for accounting (0 means TOTALPES is valid) + + + + + + + + char + UNSET + build_grid + env_build.xml + atmosphere grid - DO NOT EDIT (for experts only) + + + + integer + 0 + build_grid + env_build.xml + number of atmosphere cells in i direction - DO NOT EDIT (for experts only) + + + + integer + 0 + build_grid + env_build.xml + number of atmosphere cells in j direction - DO NOT EDIT (for experts only) + + + + char + UNSET + build_grid + env_build.xml + land grid - DO NOT EDIT (for experts only) + + + + integer + 0 + build_grid + env_build.xml + number of land cells in i direction - DO NOT EDIT (for experts only) + + + + integer + 0 + build_grid + env_build.xml + number of land cells in j direction - DO NOT EDIT (for experts only) + + + + char + UNSET + build_grid + env_build.xml + ocn grid - DO NOT EDIT (for experts only) + + + + integer + 0 + build_grid + env_build.xml + number of ocn cells in i direction - DO NOT EDIT (for experts only) + + + + integer + 0 + build_grid + env_build.xml + number of ocn cells in j direction - DO NOT EDIT (for experts only) + + + + char + UNSET + build_grid + env_build.xml + ice grid (must equal ocn grid) - DO NOT EDIT (for experts only) + + + + integer + 0 + build_grid + env_build.xml + number of ice cells in i direction - DO NOT EDIT (for experts only) + + + + integer + 0 + build_grid + env_build.xml + number of ice cells in j direction - DO NOT EDIT (for experts only) + + + + integer + 1 + build_grid + env_build.xml + number of ice thickness categories - DO NOT EDIT (set by CICE configure) + + + + char + UNSET + build_grid + env_build.xml + river runoff (rof) grid + + + + integer + 0 + build_grid + env_build.xml + number of rof cells in i direction - DO NOT EDIT (for experts only) + + + + integer + 0 + build_grid + env_build.xml + number of rof cells in j direction - DO NOT EDIT (for experts only) + + + + char + gland20,gland10,gland5,gland5UM,gland4,mpas.gis20km,mpas.ais20km,null + gland5UM + build_grid + env_build.xml + glacier (glc) grid - DO NOT EDIT (for experts only) + + + + integer + 0 + build_grid + env_build.xml + number of glc cells in i direction - DO NOT EDIT (for experts only) + + + + integer + 0 + build_grid + env_build.xml + number of glc cells in j direction - DO NOT EDIT (for experts only) + + + + + char + UNSET + build_grid + env_build.xml + wave model (wav) grid + + + + integer + 0 + build_grid + env_build.xml + number of wav cells in i direction - DO NOT EDIT (for experts only) + + + + integer + 0 + build_grid + env_build.xml + number of wav cells in j direction - DO NOT EDIT (for experts only) + + + + char + UNSET + build_grid + env_build.xml + grid mask - DO NOT EDIT (for experts only) + + + + logical + TRUE,FALSE + FALSE + run_domain + env_run.xml + Operate on only a single point of the global grid - DO NOT EDIT (for experts only) + + + + real + -999.99 + run_domain + env_run.xml + Latitude to find nearest points for points mode (only used if PTS_MODE is TRUE) + + + + real + -999.99 + run_domain + env_run.xml + Longitude to find nearest points for points mode (only used if PTS_MODE is TRUE) + + + + + + + + char + UNSET + run_domain + env_run.xml + atm domain file + + + char + $DIN_LOC_ROOT/share/domains + run_domain + env_run.xml + path of atm domain file + + + char + UNSET + run_domain + env_run.xml + atm mesh file (full pathname) + + + + char + UNSET + run_domain + env_run.xml + lnd domain file + + + char + $DIN_LOC_ROOT/share/domains + run_domain + env_run.xml + path of lnd domain file + + + char + UNSET + run_domain + env_run.xml + lnd mesh file (full pathname) + + + + char + UNSET + run_domain + env_run.xml + rof domain file + + + char + $DIN_LOC_ROOT/share/domains + run_domain + env_run.xml + path of rof domain file + + + char + UNSET + run_domain + env_run.xml + rof mesh file (full pathname) + + + + char + UNSET + run_domain + env_run.xml + wav domain file + + + char + $DIN_LOC_ROOT/share/domains + run_domain + env_run.xml + path of wav domain file + + + char + UNSET + run_domain + env_run.xml + wav mesh file (full pathname) + + + + char + UNSET + run_domain + env_run.xml + ice domain file + + + char + $DIN_LOC_ROOT/share/domains + run_domain + env_run.xml + path of ice domain file + + + char + UNSET + run_domain + env_run.xml + ice mesh file (full pahtname) + + + + char + UNSET + run_domain + env_run.xml + ocn domain file + + + char + $DIN_LOC_ROOT/share/domains + run_domain + env_run.xml + path of ocn domain file + + + char + UNSET + run_domain + env_run.xml + ocn mesh file (full pathname) + + + + char + UNSET + run_domain + env_run.xml + glc domain file + + + char + $DIN_LOC_ROOT/share/domains + run_domain + env_run.xml + path of glc domain file + + + char + UNSET + run_domain + env_run.xml + glc mesh file (full pathname) + + + + + + + char + idmap + run_domain + env_run.xml + atm2ocn flux mapping file + + + + char + idmap + run_domain + env_run.xml + atm2ocn state mapping file + + + + char + idmap + run_domain + env_run.xml + atm2ocn vector mapping file + + + + char + idmap + run_domain + env_run.xml + atm2lnd flux mapping file + + + + char + idmap + run_domain + env_run.xml + atm2lnd state mapping file + + + + char + idmap + run_domain + env_run.xml + atm2wav state mapping file + + + + char + idmap + run_domain + env_run.xml + ocn2atm flux mapping file + + + + char + idmap + run_domain + env_run.xml + ocn2atm state mapping file + + + + char + idmap + run_domain + env_run.xml + lnd2atm flux mapping file + + + + char + idmap + run_domain + env_run.xml + lnd2atm state mapping file + + + + char + idmap + run_domain + env_run.xml + lnd2glc flux mapping file + + + + char + idmap + run_domain + env_run.xml + lnd2glc state mapping file + + + + char + idmap + run_domain + env_run.xml + lnd2rof flux mapping file + + + + char + idmap + run_domain + env_run.xml + rof2lnd flux mapping file + + + + char + idmap + run_domain + env_run.xml + rof2ocn flux mapping file + + + + char + idmap + run_domain + env_run.xml + rof2ocn runoff mapping file + + + + char + idmap + run_domain + env_run.xml + rof2ocn runoff mapping file + + + + char + idmap + run_domain + env_run.xml + glc2lnd flux mapping file + + + + char + idmap + run_domain + env_run.xml + glc2lnd state mapping file + + + + char + idmap + run_domain + env_run.xml + glc2ice runoff mapping file + + + + char + idmap + run_domain + env_run.xml + glc2ocn runoff mapping file for liquid runoff + + + + char + idmap + run_domain + env_run.xml + glc2ocn runoff mapping file for ice runoff + + + + char + idmap + run_domain + env_run.xml + ocn2wav state mapping file + + + + char + idmap + run_domain + env_run.xml + ice2wav state mapping file + + + + char + idmap + run_domain + env_run.xml + wav2ocn state mapping file + + + + char + none,npfix,cart3d,cart3d_diag,cart3d_uvw,cart3d_uvw_diag + cart3d + run_domain + env_run.xml + vector mapping option + + + + char + 1.0e-02 + run_domain + env_run.xml + Error tolerance for differences in fractions in domain checking + + + + real + 9.0e-07 + run_domain + env_run.xml + Error tolerance for differences in atm/land areas in domain checking + + + + real + 1.0e-13 + run_domain + env_run.xml + Error tolerance for differences in atm/land masks in domain checking + + + + real + 1.0e-12 + run_domain + env_run.xml + Error tolerance for differences in atm/land lat/lon in domain checking + + + + real + 1.0e-01 + run_domain + env_run.xml + Error tolerance for differences in ocean/ice lon/lat in domain checking + + + + real + 1.0e-06 + run_domain + env_run.xml + Error tolerance for differences in ocean/ice lon/lat in domain checking + + + + real + 1.0e-02 + run_domain + env_run.xml + Error tolerance for differences in ocean/ice lon/lat in domain checking + + + + + + + + char + UNSET + case_def + env_case.xml + Machine name + + + + char + + case_def + env_case.xml + Machines directory location + + + + char + $CIME_OUTPUT_ROOT/$CASE/run + run_desc + env_run.xml + + The directory where the executable will be run. + By default this is set to EXEROOT/../run. + RUNDIR allows you to keep the run directory separate from the build directory + + + + + char + UNSET + run_din + env_run.xml + + A regular expression to match machine node names to ACME machine. + + + + + char + run_din + env_run.xml + + A regular expression to search for an indication that a run failure was caused by a node failure + and should therefore be re-attempted. + + + + + char + UNSET + run_din + env_run.xml + + Proxy (if any) setting for http_proxy to allow web access on this machine. + + + + + logical + FALSE + run_din + env_run.xml + + Indicates to case.submit that this is a test case. + + + + + char + UNSET + run_din + env_run.xml + + The root directory of all CIME and component input data for the selected machine. + This is usually a shared disk area. + Default values for the target machine are in the + $CIMEROOT/machines/config_machines.xml + + + + + char + UNSET + run_din + env_run.xml + CLM-specific root directory for CLM type input forcing data + This directory will only be used for I (CLM/DATM) compsets and only + for datm forcing data that is NOT checked into the svn repository + (datasets other than the Qian or single-point forcing). + This is usually a shared disk area. + Default values for the target machine are in the + $CIMEROOT/machines/config_machines.xml + + + + char + UNSET + run_dout + env_run.xml + Root directory for short term archiving. This directory must be visible to compute nodes. + + + + char + UNSET + run_mpi + env_run.xml + override the mpi run command, do not include model executable + + + + + + + + logical + TRUE,FALSE + FALSE + mach_pes + env_mach_pes.xml + Allocate some spare nodes to handle node failures. The system will pick a reasonable number + + + + integer + -999 + mach_pes + env_mach_pes.xml + Force this exact number of spare nodes to be allocated + + + + integer + + $MAX_MPITASKS_PER_NODE + $MAX_MPITASKS_PER_NODE + $MAX_MPITASKS_PER_NODE + $MAX_MPITASKS_PER_NODE + $MAX_MPITASKS_PER_NODE + $MAX_MPITASKS_PER_NODE + $MAX_MPITASKS_PER_NODE + $MAX_MPITASKS_PER_NODE + $MAX_MPITASKS_PER_NODE + + mach_pes + env_mach_pes.xml + number of tasks for each component + + + + integer + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + mach_pes + env_mach_pes.xml + Number of tasks per instance for each component. DO NOT EDIT: Set automatically by case.setup based on NTASKS, NINST and MULTI_DRIVER + + + + integer + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + mach_pes + env_mach_pes.xml + number of threads for each task in each component + + + + integer + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + mach_pes + env_mach_pes.xml + ROOTPE (mpi task in MPI_COMM_WORLD) for each component + + + logical + TRUE + TRUE + mach_pes + env_mach_pes.xml + MULTI_DRIVER mode provides a separate driver/coupler component for each + ensemble member. All components must have an equal number of members. + Multidriver is always true for nuopc, variable is left for compatibility with the mct driver + + + + integer + + 1 + + mach_pes + env_mach_pes.xml + Number of instances of the model. + + + + + integer + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + mach_pes + env_mach_pes.xml + The mpi global processors stride associated with the mpi tasks for the a component + + + + integer + 0 + mach_pes_last + env_mach_pes.xml + total number of MPI tasks (setup automatically - DO NOT EDIT) + + + + integer + 0 + mach_pes_last + env_mach_pes.xml + maximum number of tasks/ threads allowed per node + + + + integer + 0 + mach_pes_last + env_mach_pes.xml + pes or cores per node for accounting purposes + + + + integer + $MAX_MPITASKS_PER_NODE + mach_pes_last + env_mach_pes.xml + pes or cores per node for accounting purposes + + + + + + + + integer + 2 + 1,2 + build_macros + env_build.xml + PIO library version + + + + char + + build_macros + env_build.xml + PIO configure options, see PIO configure utility for details + + + + logical + TRUE,FALSE + FALSE + run_pio + env_run.xml + TRUE implies perform asynchronous i/o + + + + char + p2p,coll,default + p2p + run_pio + env_run.xml + pio rearranger communication type + + + + char + 2denable,io2comp,comp2io,disable,default + 2denable + run_pio + env_run.xml + pio rearranger communication flow control direction + + + + integer + + 0 + run_pio + env_run.xml + pio rearranger communication max pending requests (comp2io) : 0 implies that CIME internally calculates the value ( = max(64, 2 * PIO_NUMTASKS) ), -1 implies no bound on max pending requests + + + + logical + TRUE,FALSE + TRUE + run_pio + env_run.xml + pio rearranger communiation options (comp2io) : TRUE implies enable handshake + + + + logical + TRUE,FALSE + FALSE + run_pio + env_run.xml + pio rearranger communiation options (comp2io) : TRUE implies enable isend + + + + integer + + 64 + run_pio + env_run.xml + pio rearranger communication max pending requests (io2comp) : -1 implies no bound on max pending requests + + + + + + logical + TRUE,FALSE + FALSE + run_pio + env_run.xml + pio rearranger communiation options (io2comp) : TRUE implies enable handshake + + + + logical + TRUE,FALSE + TRUE + run_pio + env_run.xml + pio rearranger communiation options (io2comp) : TRUE implies enable isend + + + + + integer + 0 + run_pio + env_run.xml + pio debug level + + + + integer + -1 + run_pio + env_run.xml + pio blocksize for box decompositions + + + + integer + -1 + run_pio + env_run.xml + pio buffer size limit for pnetcdf output + + + + char + netcdf,pnetcdf,netcdf4p,netcdf4c,default + run_pio + env_run.xml + pio io type + + default + default + default + default + default + default + default + default + default + + + + + char + classic,64bit_offset,64bit_data + run_pio + env_run.xml + pio netcdf format (ignored for netcdf4p and netcdf4c) + https://www.unidata.ucar.edu/software/netcdf/docs/data_type.html + + + 64bit_offset + 64bit_offset + 64bit_offset + 64bit_offset + 64bit_offset + 64bit_offset + 64bit_offset + 64bit_offset + 64bit_offset + + + + + integer + run_pio + env_run.xml + + stride in compute comm of io tasks for each component, if this value is -99 it will + be computed based on PIO_NUMTASKS and number of compute tasks + + + + + + + + + + + + + + + + integer + 1,2 + run_pio + env_run.xml + pio rearranger choice box=1, subset=2 + + $PIO_VERSION + + + + + + + + + + + + + + integer + run_pio + env_run.xml + pio root processor relative to component root + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + + + integer + run_pio + env_run.xml + + pio number of io tasks, if this value is -99 it will be computed based on PIO_STRIDE and + number of tasks + + + -99 + -99 + -99 + -99 + -99 + -99 + -99 + -99 + -99 + + + + + + + + + char + UNSET + test + env_test.xml + Test type name + + + + char + UNSET + test + env_test.xml + Test type descriptor + + + + char + UNSET + test + env_test.xml + Testcase short name + + + + char + UNSET + test + env_test.xml + Case base ID + + + + logical + TRUE,FALSE + TRUE + test + env_test.xml + Is first run of test + + + + char + UNSET + test + env_test.xml + Arguments supplied to create_test + + + + char + UNSET + test + env_test.xml + supplied or computed test id + + + + real + 0.10 + test + env_test.xml + Expected relative memory usage growth for test + + + + real + 0.25 + test + env_test.xml + Expected throughput deviation + + + + logical + TRUE,FALSE + FALSE + test + env_test.xml + Whether to generate a baseline + + + + logical + TRUE,FALSE + FALSE + test + env_test.xml + Whether to compare the baseline + + + + char + UNSET + test + env_test.xml + The tagname we are comparing baselines against + + + + char + UNSET + test + env_test.xml + The tagname we are comparing baselines against + + + + char + /UNSET + test + env_test.xml + The directory where baselines are stored + + + + char + UNSET + test + env_test.xml + The tagname we are generating baselines for + + + + char + UNSET + test + env_test.xml + The tagname we are comparing baselines against + + + + logical + TRUE,FALSE + FALSE + test + env_test.xml + Whether to clean the test after it is built/run + + + + char + UNSET + test + env_test.xml + standard full pathname of the cprnc executable + + + + + + + + logical + TRUE,FALSE + FALSE + run_coupling + env_run.xml + determine if per ice thickness category fields are passed from ice to ocean - DO NOT EDIT (set by POP build-namelist) + + + + + + + + char + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,ifdays0,end + never + run_drv_history + env_run.xml + Sets driver snapshot history file frequency (like REST_OPTION) + + + + integer + + -999 + run_drv_history + env_run.xml + Sets driver snapshot history file frequency (like REST_N) + + + + + integer + + -999 + run_drv_history + env_run.xml + yyyymmdd format, sets coupler snapshot history date (like REST_DATE) + + + + integer + 0,1,2,3,4,5,6 + 0 + run_flags + env_run.xml + Coupler decomposition option. + + + + integer + 0,1,2,3,4,5,6,7,8,9 + 1 + run_flags + env_run.xml + level of debug output, 0=minimum, 1=normal, 2=more, 3=too much + + + + logical + TRUE,FALSE + FALSE + build_component_clm + env_build.xml + TRUE implies CLM is built with support for the PETSc + library. The Variably Saturated Flow Model (VSFM) solver in CLM + uses the PETSc library. In order to use the VSFM solver, CLM + must be built with PETSc support and linking to PETSc must occur + when building the ACME executable. This occurs if this variable + is set to TRUE. Note that is only available on a limited set of + machines/compilers. + + + + + + char + + external_tools + env_run.xml + External script to be run before model completion + + + char + + external_tools + env_run.xml + External script to be run after model completion + + + + + + logical + TRUE,FALSE + external_tools + env_run.xml + Run the external tool pointed to by DATA_ASSIMILATION_SCRIPT after the model run completes + + FALSE + FALSE + FALSE + FALSE + FALSE + FALSE + FALSE + FALSE + + + + + integer + + 1 + external_tools + env_run.xml + Number of model run - data assimilation steps to complete + + + char + + + external_tools + env_run.xml + External script to be run after model completion + + + + + char + job_submission + env_batch.xml + Store user override for queue + + + + char + job_submission + env_batch.xml + Store user override for walltime + + + + char + + + job_submission + env_batch.xml + The machine queue in which to submit the job. Default determined in config_machines.xml can be overwritten by testing + + + + char + + + job_submission + env_batch.xml + The machine wallclock setting. Default determined in config_machines.xml can be overwritten by testing + + + + char + + + job_submission + env_batch.xml + Override the batch submit command this job. Do not include executable or dependencies + + + + char + + job_submission + env_batch.xml + project for project-sensitive build and run paths, and job scripts + + + + char + + job_submission + env_batch.xml + project to charge in scripts if different from PROJECT + + + + char + unknown + case_der + env_case.xml + Apparent version of the model used for this case + + + + logical + TRUE,FALSE + FALSE + job_submission + env_batch.xml + whether the PROJECT value is required on this machine + + + + ========================================= + Notes: + (1) Time period is first four characters of + compset name + ========================================= + + + diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml new file mode 100644 index 00000000..544da7e2 --- /dev/null +++ b/cime_config/config_component_cesm.xml @@ -0,0 +1,517 @@ + + + + + + + + + 1972-2004 + 2002-2003 + Historic transient + Twentieth century transient + + CMIP5 rcp 2.6 forcing + CMIP5 rcp 4.5 forcing + CMIP5 rcp 6.0 forcing + CMIP5 rcp 8.5 forcing + Biogeochemistry intercomponent + with diagnostic CO2 + with prognostic CO2 + + + + char + https://doi.org/10.5065/D67H1H0V + run_metadata + env_case.xml + run DOI + + + + logical + TRUE,FALSE + FALSE + run_flags + env_run.xml + Turns on component varying thread control in the driver. + Used to set the driver namelist variable "drv_threading". + + + + logical + TRUE,FALSE + FALSE + run_flags + env_run.xml + logical to save timing files in rundir + + + + integer + 0 + run_flags + env_run.xml + Determines number of times profiler is called over the model run period. + This sets values for tprof_option and tprof_n that determine the timing output file frequency + + + + + integer + 2 + run_flags + env_run.xml + + integer indicating maximum detail level to profile. This xml + variable is used to set the namelist variable + timing_detail_limit. This namelist variable is used by perf_mod + (in $CIMEROOT/src/share/timing/perf_mod.F90) to turn timers off + and on depending on calls to the routine t_adj_detailf. If in the + code a statement appears like t_adj_detailf(+1), then the current + timer detail level is incremented by 1 and compared to the + time_detail_limit obtained from the namelist. If the limit is + exceeded then the timer is turned off. + + + + + integer + 4 + run_flags + env_run.xml + Maximum code stack depth of enabled timers. + + + + logical + TRUE,FALSE + FALSE + run_data_archive + env_run.xml + Logical to archive all interim restart files, not just those at eor + If TRUE, perform short term archiving on all interim restart files, + not just those at the end of the run. By default, this value is TRUE. + The restart files are saved under the specific component directory + ($DOUT_S_ROOT/$CASE/$COMPONENT/rest rather than the top-level $DOUT_S_ROOT/$CASE/rest directory). + Interim restart files are created using the REST_N and REST_OPTION variables. + This is for expert users ONLY and requires expert knowledge. + We will not document this further in this guide. + + + + logical + TRUE,FALSE + FALSE + run_flags + env_run.xml + turns on coupler bit-for-bit reproducibility with varying pe counts + + + + char + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,ifdays0,end + never + + ndays + + run_begin_stop_restart + env_run.xml + + sets frequency of full model barrier (same options as STOP_OPTION) for synchronization with BARRIER_N and BARRIER_DATE + + + + + char + none,CO2A,CO2B,CO2C + none + + CO2A + none + CO2A + CO2A + CO2A + CO2C + CO2C + + run_coupling + env_run.xml + Activates additional CO2-related fields to be exchanged between components. Possible values are: + + CO2A: sets the driver namelist variable flds_co2a = .true.; this adds + prognostic CO2 and diagnostic CO2 at the lowest model level to be sent from + the atmosphere to the land and ocean. + + CO2B: sets the driver namelist variable flds_co2b = .true.; this adds + prognostic CO2 and diagnostic CO2 at the lowest model level to be sent from + the atmosphere just to the land, and the surface upward flux of CO2 to be + sent from the land back to the atmosphere + + CO2C: sets the driver namelist variable flds_co2c = .true.; this adds + prognostic CO2 and diagnostic CO2 at the lowest model level to be sent from + the atmosphere to the land and ocean, and the surface upward flux of CO2 + to be sent from the land and the open ocean back to the atmosphere. + + The namelist variables flds_co2a, flds_co2b and flds_co2c are in the + namelist group cpl_flds_inparm. + + + + + char + + + + + + run_component_cpl + env_case.xml + User mods to apply to specific compset matches. + + + + char + hour,day,year,decade + run_coupling + env_run.xml + day + + year + hour + + Base period associated with NCPL coupling frequency. + This xml variable is only used to set the driver namelist variables, + atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt, and esp_dt. + + + + integer + 48 + + 144 + 288 + 288 + 72 + 48 + 4 + 24 + 24 + 24 + 48 + 1 + 96 + 96 + 96 + 96 + 192 + 192 + 192 + 192 + 384 + 384 + 384 + 144 + 72 + 144 + 288 + 48 + 48 + 24 + 24 + 1 + 4 + 4 + + run_coupling + env_run.xml + Number of atm coupling intervals per NCPL_BASE_PERIOD. + This is used to set the driver namelist atm_cpl_dt, equal to basedt/ATM_NCPL, + where basedt is equal to NCPL_BASE_PERIOD in seconds. + + + + integer + $ATM_NCPL + + 1 + + run_coupling + env_run.xml + Number of land coupling intervals per NCPL_BASE_PERIOD. + This is used to set the driver namelist atm_cpl_dt, equal to basedt/LND_NCPL, + where basedt is equal to NCPL_BASE_PERIOD in seconds. + + + + integer + $ATM_NCPL + + 1 + + run_coupling + env_run.xml + Number of ice coupling intervals per NCPL_BASE_PERIOD. + This is used to set the driver namelist ice_cpl_dt, equal to basedt/ICE_NCPL + where basedt is equal to NCPL_BASE_PERIOD in seconds. + + + + integer + $ATM_NCPL + + 1 + 4 + 24 + 24 + + + + + 1 + + run_coupling + env_run.xml + Number of ocn coupling intervals per NCPL_BASE_PERIOD. + Thisn is used to set the driver namelist ocn_cpl_dt, equal to basedt/OCN_NCPL + where basedt is equal to NCPL_BASE_PERIOD in seconds. + + + + integer + 1 + + 1 + + run_coupling + env_run.xml + Number of glc coupling intervals per NCPL_BASE_PERIOD. + + + + char + glc_coupling_period,yearly + yearly + run_coupling + env_run.xml + Period at which coupler averages fields sent to GLC. + This supports doing the averaging to GLC less frequently than GLC is called + (i.e., separating the averaging frequency from the calling frequency). + This is useful because there are benefits to only averaging the GLC inputs + as frequently as they are really needed (yearly for CISM), but GLC needs to + still be called more frequently than that in order to support mid-year restarts. + + Setting GLC_AVG_PERIOD to 'glc_coupling_period' means that the averaging is + done exactly when the GLC is called (governed by GLC_NCPL). + + IMPORTANT: In order to restart mid-year when running with CISM, you MUST specify GLC_AVG_PERIOD = 'yearly'. + If using GLC_AVG_PERIOD = 'glc_coupling_period' with CISM, you can only restart on year boundaries. + + + + + integer + + $ATM_NCPL + + $ATM_NCPL + $ATM_NCPL + $ATM_NCPL + 8 + $ATM_NCPL + 1 + + run_coupling + env_run.xml + Number of rof coupling intervals per NCPL_BASE_PERIOD. + This is used to set the driver namelist rof_cpl_dt, equal to basedt/ROF_NCPL + where basedt is equal to NCPL_BASE_PERIOD in seconds. + + + + integer + $ATM_NCPL + run_coupling + env_run.xml + Number of wav coupling intervals per NCPL_BASE_PERIOD. + This is used to set the driver namelist wav_cpl_dt, equal to basedt/WAV_NCPL + where basedt is equal to NCPL_BASE_PERIOD in seconds. + + + + + + logical + TRUE,FALSE + FALSE + + TRUE + TRUE + FALSE + + run_component_cpl + env_run.xml + + Only used for compsets with DATM and POP (currently C, G and J): + If true, compute albedos to work with daily avg SW down + If false (default), albedos are computed with the assumption that downward + solar radiation from the atm component has a diurnal cycle and zenith-angle + dependence. This is normally the case when using an active atm component + If true, albedos are computed with the assumption that downward + solar radiation from the atm component is a daily average quantity and + does not have a zenith-angle dependence. This is often the case when + using a data atm component. Only used for compsets with DATM and POP (currently C, G and J). + NOTE: This should really depend on the datm forcing and not the compset per se. + So, for example, whether it is set in a J compset should depend on + what datm forcing is used. + + + + + char + off,ocn + off + + ocn + off + + run_component_cpl + env_run.xml + + Only used for compsets with DATM and POP (currently C, G and J): + If ocn, ocn provides EP balance factor for precipitation. + Provides EP balance factor for precip for POP. A factor computed by + POP is applied to precipitation so that precipitation balances + evaporation and ocn global salinity does not drift. This is intended + for use when coupling POP to a DATM. Only used for C, G and J compsets. + Default is off + + + + + char + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,ifdays0,end + never + + nmonths + + run_drv_history + env_run.xml + Sets driver average history file frequency (like REST_OPTION) + + + + char + + -999 + + 1 + + run_drv_history + env_run.xml + Sets driver average history file frequency (like REST_N) + + + + integer + + -999 + run_drv_history + env_run.xml + yyyymmdd format, sets driver average history date (like REST_DATE) + + + + logical + TRUE,FALSE + FALSE + + TRUE + TRUE + TRUE + + run_budgets + env_run.xml + logical that turns on diagnostic budgets for driver + + + + real + + 284.7 + + 367.0 + 284.7 + + run_co2 + env_run.xml + + Mechanism for setting the CO2 value in ppmv for + CLM if CLM_CO2_TYPE is constant or for + POP if OCN_CO2_TYPE is constant. + + + + + logical + TRUE,FALSE + FALSE + + TRUE + TRUE + + run_flags + env_run.xml + Turn on the passing of water isotope fields through the coupler + + + + integer + 1,3,5,10,36 + 10 + run_glc + env_run.xml + Number of glacier elevation classes used in CLM. + Used by both CLM and the coupler (even if CISM is not running, and only SGLC is used). + + + + logical + TRUE,FALSE + FALSE + + TRUE + + TRUE + + run_glc + env_run.xml + Whether the glacier component feeds back to the rest of the system + This affects: + (1) Whether CLM updates its areas based on glacier areas sent from GLC + (2) Whether GLC sends fluxes (e.g., calving fluxes) to the coupler + Note that this is set to TRUE by default for TG compsets - even though there are + no feedbacks for TG compsets, this enables extra coupler diagnostics for these + compsets. + + + + char + minus1p8,linear_salt,mushy + mushy + run_physics + env_run.xml + Freezing point calculation for salt water. + + + + diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml new file mode 100644 index 00000000..46bf5419 --- /dev/null +++ b/cime_config/config_compsets.xml @@ -0,0 +1,106 @@ + + + + + + ========================================= + compset naming convention + ========================================= + The compset longname below has the specified order + atm, lnd, ice, ocn, river, glc wave esp cesm-options + + The notation for the compset longname below is + TIME_ATM[%phys]_LND[%phys]_ICE[%phys]_OCN[%phys]_ROF[%phys]_GLC[%phys]_WAV[%phys][_ESP][_BGC%phys] + + The following compsets are those that can be tested in CIME stand-alone configurations + without any prognostic components. + For the compsets below the following are the only allowable values of the components. + + TIME = Time period (e.g. 2000, HIST, RCP8...) + ATM = [DATM, SATM, XATM] + LND = [DLND, SLND, XLND] + ICE = [DICE, SICE, XICE] + OCN = [DOCN, SOCN, XOCN] + ROF = [DROF, SROF, XROF] + GLC = [ SGLC ] + WAV = [DWAV, SWAV ] + ESP = [DESP, SESP ] + + The OPTIONAL %phys attributes specify submodes of the given system + For example DOCN%DOM is the data ocean model for DOCN + ALL data models must have a %phys option that corresponds to the data model mode + + Each compset node is associated with the following elements + - lname + - alias + - support (optional description of the support level for this compset) + Each compset node can also have the following attributes + - grid (optional regular expression match for grid to work with the compset) + + + + AA + 2000_DATM%NYF_DLND%LCPL_DICE%SSMI_DOCN%DOM_DROF%NYF_SGLC_DWAV + + + + A + 2000_DATM%NYF_SLND_DICE%SSMI_DOCN%DOM_DROF%NYF_SGLC_SWAV + + + + ADSOM + 2000_DATM%NYF_SLND_DICE%SSMI_DOCN%SOM_DROF%NYF_SGLC_SWAV_TEST + + + + ADSOMAQP + 2000_DATM%NYF_SLND_SICE_DOCN%SOMAQP_SROF_SGLC_SWAV + + + + ADAQP3 + 2000_DATM%NYF_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV + + + + ADAQPFILE + 2000_DATM%NYF_SLND_SICE_DOCN%AQPFILE_SROF_SGLC_SWAV + + + + A1850DLND + 1850_SATM_DLND%SCPL_SICE_SOCN_SROF_SGLC_SWAV + + + + ADWAV + 2000_SATM_SLND_SICE_SOCN_SROF_SGLC_DWAV%CLIMO + + + + ADESP + 2000_DATM%NYF_SLND_SICE_DOCN%SOMAQP_SROF_SGLC_SWAV_DESP%NOOP + + + + ADESP_TEST + 2000_DATM%NYF_SLND_SICE_DOCN%SOMAQP_SROF_SGLC_SWAV_DESP%TEST + + + + AIAF + 2000_DATM%IAF_SLND_DICE%IAF_DOCN%IAF_DROF%IAF_SGLC_SWAV + + + + S + 2000_SATM_SLND_SICE_SOCN_SROF_SGLC_SWAV_SESP + + + + X + 2000_XATM_XLND_XICE_XOCN_XROF_XGLC_XWAV + + + diff --git a/cime_config/config_pes.xml b/cime_config/config_pes.xml new file mode 100644 index 00000000..ad332b3f --- /dev/null +++ b/cime_config/config_pes.xml @@ -0,0 +1,210 @@ + + + + + + + + none + + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + + none + + 60 + 60 + 60 + 60 + 60 + 60 + 60 + 60 + 60 + + + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + + none + + -8 + -8 + -8 + -8 + -8 + -8 + -8 + -8 + -8 + + + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 1 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + + none + + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + -1 + + + 8 + 8 + 8 + 8 + 8 + 8 + 8 + 8 + 8 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + + + + PE layout for tests + + 64 + 64 + 64 + 64 + 64 + 64 + 64 + 64 + 64 + + + 16 + 16 + 16 + 16 + 16 + 16 + 16 + 16 + 16 + + + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + + + + + diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml new file mode 100644 index 00000000..e0263c68 --- /dev/null +++ b/cime_config/namelist_definition_drv.xml @@ -0,0 +1,3767 @@ + + + + + + + + + + + + char + nuopc + nuopc_var + + ATM OCN ICE LND ROF GLC WAV MED + + + + + char + nuopc + DRIVER_attributes + + $INFO_DBUG + + + + + + + char + nuopc + DRIVER_attributes + + 0 + + + + + char + nuopc + nuopc_var + + cesm + e3sm + + + + + char + nuopc + MED_attributes + + $INFO_DBUG + + + + + char + nuopc + nuopc_var + + $COMP_ATM + + + + + char + nuopc + ATM_attributes + + $INFO_DBUG + + + + + char + nuopc + nuopc_var + + $COMP_OCN + + + + + char + nuopc + OCN_attributes + + $INFO_DBUG + + + + + char + nuopc + nuopc_var + + $COMP_ICE + + + + + char + nuopc + ICE_attributes + + $INFO_DBUG + + + + + char + nuopc + nuopc_var + + $COMP_ROF + + + + + char + nuopc + ROF_attributes + + $INFO_DBUG + + + + + char + nuopc + nuopc_var + + $COMP_LND + + + + + char + nuopc + LND_attributes + + $INFO_DBUG + + + + + char + nuopc + nuopc_var + + $COMP_GLC + + + + + char + nuopc + GLC_attributes + + $INFO_DBUG + + + + + char + nuopc + nuopc_var + + $COMP_WAV + + + + + char + nuopc + WAV_attributes + + $INFO_DBUG + + + + + + + + + char + expdef + DRIVER_attributes + e3sm,cesm + cime model + + cesm + e3sm + + + + + char + expdef + DRIVER_attributes + + location of timing output. + + + ./timing + + + + + char + expdef + DRIVER_attributes + + location of timing checkpoint output. + + + ./timing/checkpoints + + + + + logical + expdef + DRIVER_attributes + + turns on bfb option in coupler which produce bfb results in the + coupler on different processor counts. (default: .false.) + + + $BFBFLAG + + + + + char + orbital + DRIVER_attributes + fixed_year,variable_year,fixed_parameters + + orbital model setting. this sets how the orbital mode will be + configured. + "fixed_year" uses the orb_iyear and other orb inputs are ignored. In + this mode, the orbital parameters are constant and based on the year. + "variable_year" uses the orb_iyear and orb_iyear_align. In this mode, + the orbital parameters vary as the model year advances and the model + year orb_iyear_align has the equivalent orbital year of orb_iyear. + "fixed_parameters" uses the orb_eccen, orb_mvelp, and orb_obliq to set + the orbital parameters which then remain constant through the model + integration. [fixed_year, variable_year, fixed_parameters] (default: 'fixed_year'.) + + + fixed_year + variable_year + + + + + integer + orbital + DRIVER_attributes + + model year associated with orb_iyear when orb_mode is variable_year. (default: 1990) + + + 1990 + 1850 + 2000 + 1850 + + + + + integer + orbital + DRIVER_attributes + + year of orbit, used when orb_mode is fixed_year or variable_year. (default: 1990) + + + 1990 + 1850 + 2000 + 1850 + + + + + real + orbital + DRIVER_attributes + + eccentricity of orbit, used when orb_mode is fixed_parameters. + default: SHR_ORB_UNDEF_REAL (1.e36) (Not currently used in build-namelist) + + + 1.e36 + + + + + real + orbital + DRIVER_attributes + + location of vernal equinox in longitude degrees, used when orb_mode is fixed_parameters. + default: SHR_ORB_UNDEF_REAL (1.e36)(Not currently used in build-namelist) + + + 1.e36 + + + + + real + orbital + DRIVER_attributes + + obliquity of orbit in degrees, used when orb_mode is fixed_parameters. + default: SHR_ORB_UNDEF_REAL (1.e36) (Not currently used in build-namelist) + + + 1.e36 + + + + + char + wv_sat + DRIVER_attributes + GoffGratch,MurphyKoop,Bolton,Flatau + + Type of water vapor saturation vapor pressure scheme employed. 'GoffGratch' for + Goff and Gratch (1946); 'MurphyKoop' for Murphy and Koop (2005); 'Bolton' for + Bolton (1980); 'Flatau' for Flatau, Walko, and Cotton (1992). + Default: GoffGratch + + + GoffGratch + + + + + real + wv_sat + DRIVER_attributes + + Width of the liquid-ice transition range in mixed-phase water saturation vapor + pressure calculations. The range always ends at 0 degrees Celsius, so this + variable only affects the start of the transition. + Default: 20K + WARNING: CAM is tuned to the default value of this variable. Because it affects + so many different parameterizations, changes to this variable may require a + significant retuning of CAM's cloud physics to give reasonable results. + + + 20.0D0 + + + + + logical + wv_sat + DRIVER_attributes + + Whether or not to produce lookup tables at init time to use as a cache for + saturation vapor pressure. + Default: .false. + + + .false. + + + + + real + wv_sat + DRIVER_attributes + + Temperature resolution of saturation vapor pressure lookup tables in Kelvin. + (This is only used if wv_sat_use_tables is .true.) + Default: 1.0 + + + 1.0D0 + + + + + char + control + DRIVER_attributes + on,off,on_if_glc_coupled_fluxes + + Whether to renormalize the surface mass balance (smb) sent from lnd to glc so that the + global integral on the glc grid agrees with the global integral on the lnd grid. + + Unlike most fluxes, smb is remapped with bilinear rather than conservative mapping weights, + so this option is needed for conservation. However, conservation is not required in many + cases, since we often run glc as a diagnostic (one-way-coupled) component. + + Allowable values are: + 'on': always do this renormalization + 'off': never do this renormalization (see WARNING below) + 'on_if_glc_coupled_fluxes': Determine at runtime whether to do this renormalization. + Does the renormalization if we're running a two-way-coupled glc that sends fluxes + to other components (which is the case where we need conservation). + Does NOT do the renormalization if we're running a one-way-coupled glc, or if + we're running a glc-only compset (T compsets). + (In these cases, conservation is not important.) + + Only used if running with a prognostic GLC component. + + WARNING: Setting this to 'off' will break conservation when running with an + evolving, two-way-coupled glc. + + + on_if_glc_coupled_fluxes + + + + + real + control + DRIVER_attributes + + Wall time limit for run + default: -1.0 + + + -1.0 + + + + + char + control + DRIVER_attributes + day,month,year + + Force stop at the next month, day, etc when wall_time_limit is hit + default: month + + + month + + + + + + + + + + + + + + + + + logical + performance + DRIVER_attributes + + turn on run time control of threading per pe per component by the driver + default: false + + + $DRV_THREADING + + + + + logical + performance + DRIVER_attributes + + default: .false. + + + $COMP_RUN_BARRIERS + + + + + logical + reprosum + DRIVER_attributes + + Use faster method for reprosum, but one where reproducibility is not always guaranteed. + default: .false. + + + .false. + + + + + real + reprosum + DRIVER_attributes + + Tolerance for relative error + default: -1.0e-8 + + + -1.0e-8 + + + + + logical + reprosum + DRIVER_attributes + + Recompute with non-scalable algorithm if reprosum_diffmax is exceeded. + default: .false. + + + .false. + + + + + char + expdef + DRIVER_attributes + + Ending suffix "postfix" for output log files. + + + .log + + + + + char + expdef + DRIVER_attributes + + Root for output log files. + + + ./ + + + + + real + expdef + DRIVER_attributes + + Abort if cplstep time exceeds this value + + + 0. + + + + + char + expdef + ALLCOMP_attributes + + Model version + + + unknown + + + + + char + expdef + ALLCOMP_attributes + startup,branch,continue + + mode to start the run up, [startup,branch,continue], + automatically derived from RUN_TYPE in env_run.xml + + + startup + startup + branch + continue + continue + continue + + + + + logical + expdef + DRIVER_attributes + + only have the mediator reads the restart file regardless of start type + + + + + char + expdef + ALLCOMP_attributes + + case name. + + + $CASE + + + + + char + expdef + ALLCOMP_attributes + + case description. + + + $CASESTR + + + + + char + expdef + seq_infodata_inparm + + model doi url + + + $MODEL_DOI_URL + + + + + char + expdef + ALLCOMP_attributes + + username documentation + + + $USER + + + + + char + expdef + ALLCOMP_attributes + + hostname information, + + + $MACH + + + + + logical + expdef + ALLCOMP_attributes + + Allow same branch casename as reference casename. If $CASE and $REFCASE are the same and the start_type is + not startup, then the value of brnch_retain_casename is set to .true. + + + .false. + + + + + logical + expdef + ALLCOMP_attributes + + Perpetual flag + + + .false. + + + + + integer + expdef + ALLCOMP_attributes + + Perpetual date + + + -999 + + + + + logical + single_column + ALLCOMP_attributes + + turns on single column mode. set by PTS_MODE in env_case.xml, default: false + + + .false. + .true. + + + + + real + single_column + ALLCOMP_attributes + + grid point latitude associated with single column mode. + if set to -999, ignore this value + + + -999. + $PTS_LAT + + + + + real + single_column + ALLCOMP_attributes + + grid point longitude associated with single column mode. + set by PTS_LON in env_run.xml. + + + -999. + $PTS_LON + + + + + logical + expdef + ALLCOMP_attributes + + true => turn on aquaplanet mode in cam + + + .false. + + + + + logical + flds + ALLCOMP_attributes + + .true. if select per ice thickness category fields are passed to the ocean. + Set by the xml variable CPL_I2O_PER_CAT in env_run.xml + + + $CPL_I2O_PER_CAT + + + + + char + control + ALLCOMP_attributes + Freezing point calculation for salt water. + + $TFREEZE_SALTWATER_OPTION + + + + + + + + + real + control + ALLCOMP_attributes + + Iterate atmocn flux calculation to this % difference + Setting this to zero will always do flux_max_iteration + + + 0.0 + 0.0 + + + + + integer + control + ALLCOMP_attributes + + Iterate atmocn flux calculation a max of this value + + + 2 + 5 + 2 + + + + + logical + control + ALLCOMP_attributes + + if true use Mahrt and Sun 1995,MWR modification to surface flux calculation + + + .true. + .false. + + + + + + + + + integer + expdef + MED_attributes + + Level of debug output, 0=minimum, 1=normal, 2=more, 3=too much (default: 1) + + + $INFO_DBUG + + + + + char + mapping + ATM_attributes + + MESH description of atm grid + + + $ATM_DOMAIN_MESH + + + + + char + mapping + LND_attributes + + MESH description of lnd grid + + + $LND_DOMAIN_MESH + + + + + char + mapping + OCN_attributes + + MESH description of ocn grid + + + $OCN_DOMAIN_MESH + + + + + char + mapping + ICE_attributes + + MESH description of ice grid + + + $ICE_DOMAIN_MESH + + + + + char + mapping + ROF_attributes + + MESH description of rof grid + + + $ROF_DOMAIN_MESH + + + + + char + mapping + GLC_attributes + + MESH description of glc grid + + + $GLC_DOMAIN_MESH + + + + + char + mapping + WAV_attributes + + MESH description of wav grid + + + $WAV_DOMAIN_MESH + + + + + real + domain_check + MED_attributes + + Error tolerance for differences in fractions in domain checking + default: 1.0e-02 + + + $EPS_FRAC + + + + + real + domain_check + MED_attributes + + Error tolerance for differences in atm/land masks in domain checking + default: 1.0e-13 + + + $EPS_AMASK + + + + + real + domain_check + MED_attributes + + Error tolerance for differences in atm/land lat/lon in domain checking + default: 1.0e-12 + + + $EPS_AGRID + + + + + real + domain_check + MED_attributes + + Error tolerance for differences in atm/land areas in domain checking + default: 1.0e-07 + + + $EPS_AAREA + + + + + real + domain_check + MED_attributes + + Error tolerance for differences in ocean/ice masks in domain checking + default: 1.0e-06 + + + $EPS_OMASK + + + + + real + domain_check + MED_attributes + + Error tolerance for differences in ocean/ice lon/lat in domain checking + default: 1.0e-2 + + + $EPS_OGRID + + + + + real + domain_check + MED_attributes + + Error tolerance for differences in ocean/ice lon/lat in domain checking + default: 1.0e-1 + + + $EPS_OAREA + + + + + char + control + MED_attributes + off,ocn + + Only used for C,G compsets: if ocn, ocn provides EP balance factor for precip + + + $CPL_EPBAL + + + + + logical + control + MED_attributes + + Only used for C,G compsets: if true, compute albedos to work with daily avg SW down + + + $CPL_ALBAV + + + + + char + mapping + MED_attributes + ocn,atm,exch + + Grid for atm ocn flux calc (untested) + default: ocn + + + ocn + + + + + real + control + MED_attributes + + wind gustiness factor + + + 0.0D0 + + + + + logical + budget + MED_attributes + + logical that turns on diagnostic budgets, false means budgets will never be written + + + $BUDGETS + + + + + integer + budget + MED_attributes + 0,1,2,3 + + sets the diagnotics level of the instantaneous budgets. [0,1,2,3], + written only if BUDGETS variable is true + 0=none, + 1=+net summary budgets, + 2=+detailed lnd/ocn/ice component budgets, + 3=+detailed atm budgets + default: 0 + + + 0 + + + + + integer + budget + MED_attributes + 0,1,2,3 + + sets the diagnotics level of the daily budgets. [0,1,2,3], + written only if do_budgets variable is .true., + 0=none, + 1=+net summary budgets, + 2=+detailed lnd/ocn/ice component budgets, + 3=+detailed atm budgets + default: 0 +n + + 0 + + + + char + expdef + MED_attributes + + Mediator restart pointer file. + + + rpointer.med + + + + + char + expdef + MED_attributes + + Full archive path to restart file for mediator + + + str_undefined + + + + + integer + expdef + MED_attributes + 0,1,2,3 + + sets the diagnotics level of the monthy budgets. [0,1,2,3], + written only if do_budgets variable is .true., + 0=none, + 1=+net summary budgets, + 2=+detailed lnd/ocn/ice component budgets, + 3=+detailed atm budgets + default: 1 + + + 1 + + + + + integer + budget + MED_attributes + 0,1,2,3 + + sets the diagnotics level of the annual budgets. [0,1,2,3], + written only if do_budgets variable is .true., + 0=none, + 1=+net summary budgets, + 2=+detailed lnd/ocn/ice component budgets, + 3=+detailed atm budgets + default: 1 + + + 1 + + + + + integer + budget + MED_attributes + 0,1,2,3 + + sets the diagnotics level of the longterm budgets written at the end + of the year. [0,1,2,3], + written only if do_budgets variable is .true., + 0=none, + 1=+net summary budgets, + 2=+detailed lnd/ocn/ice component budgets, + 3=+detailed atm budgets, + default: 1 + + + 1 + + + + + integer + budget + MED_attributes + 0,1,2,3 + + sets the diagnotics level of the longterm budgets written at the end + of each run. [0,1,2,3], + written only if do_budgets variable is .true., + 0=none, + 1=+net summary budgets, + 2=+detailed lnd/ocn/ice component budgets, + 3=+detailed atm budgets, + default: 0 + + + 0 + + + + + integer + expdef + MED_attributes + 0,1,2,3,4,5,6 + + cpl decomp option (0=default, 1=comp decomp, 2=rearr comp decomp, 3=new single 1d seg + default: 0 + + + $CPL_DECOMP + + + + + + + + + logical + history + MED_history_attributes + + logical to write an extra initial coupler history file + + + .false. + + + + + logical + history + MED_history_attributes + + writes atm fields in coupler average history files. + default: true + + + .true. + + + + + logical + history + MED_history_attributes + + writes lnd fields in coupler average history files. + default: true + + + .true. + + + + + logical + history + MED_history_attributes + + writes ocn fields in coupler average history files. + default: true + + + .true. + + + + + logical + history + MED_history_attributes + + writes ice fields in coupler average history files. + default: true + + + .true. + + + + + logical + history + MED_history_attributes + + writes rof fields in coupler average history files. + default: true + + + .true. + + + + + logical + history + MED_history_attributes + + writes glc fields in coupler average history files. + default: true + + + .true. + + + + + logical + history + MED_history_attributes + + writes wav fields in coupler average history files. + default: true + + + .true. + + + + + logical + history + MED_history_attributes + + writes xao fields in coupler average history files. + default: true + + + .true. + + + + + logical + history + MED_history_attributes + + turns on coupler history stream for instantaneous atm to coupler fields. + default: false + + + .false. + + + + + logical + history + MED_history_attributes + + turns on coupler history stream for 1-hour average atm to coupler fields. + default: false + + + .false. + + + + + logical + history + MED_history_attributes + + turns on coupler history stream for 1-hour instantaneous atm to coupler fields. + default: false + + + .false. + + + + + logical + history + MED_history_attributes + + turns on coupler history stream for 3-hour average atm to coupler fields. + default: false + + + .false. + + + + + logical + history + MED_history_attributes + + turns on coupler history stream for 3-hour average atm to coupler precip fields. + default: false + + + .false. + + + + + logical + history + MED_history_attributes + + turns on coupler history stream for daily average atm to coupler fields. + default: false + + + .false. + + + + + logical + history + MED_history_attributes + + turns on coupler history stream for instantaneous land to coupler fields. + default: false + + + .false. + + + + + logical + history + MED_history_attributes + + turns on coupler history stream for instantaneous runoff to coupler fields. + default: false + + + .false. + + + + + logical + history + MED_history_attributes + + turns on coupler history stream for annual sno to coupler fields. + default: false + + + .false. + + + + + char + aux_hist + MED_history_attributes + + Auxiliary coupler a2x history fields + + + Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf + + + + + char + aux_hist + MED_history_attributes + + Auxiliary coupler a2x precipitation history output every 3 hours + + + Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl + + + + + char + aux_hist + MED_history_attributes + + Auxiliary coupler a2x history output every 24 hours + + + Faxa_bcphiwet:Faxa_bcphodry:Faxa_bcphidry:Faxa_ocphiwet:Faxa_ocphidry:Faxa_ocphodry:Faxa_dstwet1:Faxa_dstdry1:Faxa_dstwet2:Faxa_dstdry2:Faxa_dstwet3:Faxa_dstdry3:Faxa_dstwet4:Faxa_dstdry4:Sa_co2prog:Sa_co2diag + + + + + char + aux_hist + MED_history_attributes + + Auxiliary coupler a2x instantaneous history output every hour + + + Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf + + + + + char + aux_hist + MED_history_attributes + + Auxiliary coupler a2x averaged history output every hour + + + Sa_u:Sa_v + + + + + char + aux_hist + MED_history_attributes + + Auxiliary coupler a2x averaged history output every 3 hours + + + Sa_z:Sa_topo:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_dens:Sa_pbot:Sa_pslv:Faxa_lwdn:Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl:Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf:Sa_co2diag:Sa_co2prog + + + + + + + + + char + expdef + ALLCOMP_attributes + + name of the coupling field with scalar information + + + cpl_scalars + + + + + + + integer + expdef + ALLCOMP_attributes + + total number of scalars in the scalar coupling field + + + 15 + + + + + integer + expdef + ALLCOMP_attributes + + index of scalar containing global grid cell count in X dimension + + + 1 + + + + + integer + expdef + ALLCOMP_attributes + + index of scalar containing global grid cell count in Y dimension + + + 2 + + + + + char + mapping + abs + FLDS_attributes + atm to ocn flux mapping file for fluxes + + $ATM2OCN_FMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + atm to ocn state mapping file for states + + + $ATM2OCN_SMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + atm to ocn state mapping file for velocity + + + $ATM2OCN_VMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + ocn to atm mapping file for fluxes + + + $OCN2ATM_FMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + ocn to atm mapping file for states + + + $OCN2ATM_SMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + atm to ice flux mapping file for fluxes + + + $ATM2OCN_FMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + atm to ice state mapping file for states + + + $ATM2OCN_SMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + atm to ice state mapping file for velocity + + + $ATM2OCN_VMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + ice to atm mapping file for fluxes + + + $OCN2ATM_FMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + ice to atm mapping file for states + + + $OCN2ATM_SMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + atm to land mapping file for fluxes + + + $ATM2LND_FMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + atm to land mapping file for states + + + $ATM2LND_SMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + atm to land mapping file for states + + + $ATM2LND_SMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + land to atm mapping file for fluxes + + + $LND2ATM_FMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + land to atm mapping file for states + + + $LND2ATM_SMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + lnd to runoff conservative mapping file + + + $LND2ROF_FMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + runoff to lnd conservative mapping file + + + $ROF2LND_FMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + runoff to lnd conservative mapping file + + + $ROF2LND_FMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + runoff to ocn area overlap conservative mapping file + + + $ROF2OCN_FMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + glc2ocn runoff mapping file for liquid runoff + + + $GLC2OCN_LIQ_RMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + glc to ice runoff conservative mapping file + + + $GLC2ICE_RMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + glc2ocn runoff mapping file for ice runoff + + + $GLC2OCN_ICE_RMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + runoff to ocn nearest neighbor plus smoothing conservative mapping file + + + $ROF2OCN_LIQ_RMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + runoff to ocn nearest neighbor plus smoothing conservative mapping file + + + $ROF2OCN_ICE_RMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + land to glc mapping file for fluxes + + + $LND2GLC_FMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + land to glc mapping file for states + + + $LND2GLC_SMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + glc to land mapping file for fluxes + + + $GLC2LND_FMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + glc to land mapping file for states + + + $GLC2LND_SMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + atm to wav state mapping file for states + + + $ATM2WAV_SMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + atm to wav state mapping file for states + + + $ATM2WAV_SMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + ocn to wav state mapping file for states + + + $OCN2WAV_SMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + ice to wav state mapping file for states + + + $ICE2WAV_SMAPNAME + + + + + char + mapping + abs + FLDS_attributes + + wav to ocn state mapping file for states + + + $WAV2OCN_SMAPNAME + + + + + logical + flds + ALLCOMP_attributes + + Previously, new fields that were needed to be passed between components + for certain compsets were specified by cpp-variables. This has been + modified to now be use cases. This use cases are specified in the + namelist cpl_flds_inparm and are currently triggered by the xml variable CCSM_BGC. + If CCSM_BGC is set to 'CO2A', then flds_co2a will be set to .true. + + + .false. + .true. + + + + + logical + flds + ALLCOMP_attributes + + Previously, new fields that were needed to be passed between components + for certain compsets were specified by cpp-variables. This has been + modified to now be use cases. This use cases are specified in the + namelist cpl_flds_inparm and are currently triggered by the xml variable CCSM_BGC. + If CCSM_BGC is set to 'CO2B', then flds_co2b will be set to .true. + + + .false. + .true. + + + + + logical + flds + ALLCOMP_attributes + + Previously, new fields that were needed to be passed between components + for certain compsets were specified by cpp-variables. This has been + modified to now be use cases. This use cases are specified in the + namelist cpl_flds_inparm and are currently triggered by the xml variable CCSM_BGC. + If CCSM_BGC is set to 'CO2C', then flds_co2c will be set to .true. + + + .false. + .true. + + + + + logical + seq_flds + ALLCOMP_attributes + + If set to .true. BGC fields will be passed back and forth between the ocean and seaice + via the coupler. + + + .false. + .true. + + + + + + logical + flds + ALLCOMP_attributes + + Pass water isotopes between components + + + $FLDS_WISO + + + + + integer + flds + ALLCOMP_attributes + + Number of cism elevation classes. Set by the xml variable GLC_NEC in env_run.xml + + + $GLC_NEC + + + + + integer + flds + ALLCOMP_attributes + + Number of sea ice thickness categories. Set by the xml variable ICE_NCAT in env_build.xml + + + $ICE_NCAT + + + + + + + + + integer + time + CLOCK_attributes + + atm coupling interval in seconds + set via ATM_NCPL in env_run.xml. + ATM_NCPL is the number of times the atm is coupled per NCPL_BASE_PERIOD + NCPL_BASE_PERIOD is also set in env_run.xml and is the base period + associated with NCPL coupling frequency, and has valid values: hour,day,year,decade + + + + + integer + time + CLOCK_attributes + + lnd coupling interval in seconds + set via LND_NCPL in env_run.xml. + LND_NCPL is the number of times the lnd is coupled per NCPL_BASE_PERIOD + NCPL_BASE_PERIOD is also set in env_run.xml and is the base period + associated with NCPL coupling frequency, nad has valid values: hour,day,year,decade + + + + + integer + time + CLOCK_attributes + + river runoff coupling interval in seconds + currently set by default to 10800 seconds. + default: 10800 + + + + + integer + time + CLOCK_attributes + + ice coupling interval in seconds + set via ICE_NCPL in env_run.xml. + ICE_NCPL is the number of times the ice is coupled per NCPL_BASE_PERIOD + NCPL_BASE_PERIOD is also set in env_run.xml and is the base period + associated with NCPL coupling frequency, nad has valid values: hour,day,year,decade + + + + + integer + time + CLOCK_attributes + + ocn coupling interval in seconds + set via OCN_NCPL in env_run.xml. + OCN_NCPL is the number of times the ocn is coupled per NCPL_BASE_PERIOD + NCPL_BASE_PERIOD is also set in env_run.xml and is the base period + associated with NCPL coupling frequency, nad has valid values: hour,day,year,decade + + + + + integer + time + CLOCK_attributes + + glc coupling interval in seconds + set via GLC_NCPL in env_run.xml. + GLC_NCPL is the number of times the glc is coupled per NCPL_BASE_PERIOD + NCPL_BASE_PERIOD is also set in env_run.xml and is the base period + associated with NCPL coupling frequency, nad has valid values: hour,day,year,decade + + + + + char + time + CLOCK_attributes + glc_coupling_period,yearly + + $GLC_AVG_PERIOD + + + Period at which coupler averages fields sent to GLC. + This supports doing the averaging to GLC less frequently than GLC is called + (i.e., separating the averaging frequency from the calling frequency). + This is useful because there are benefits to only averaging the GLC inputs + as frequently as they are really needed (yearly for CISM), but GLC needs to + still be called more frequently than that in order to support mid-year restarts. + + Setting glc_avg_period to 'glc_coupling_period' means that the averaging is + done exactly when the GLC is called (governed by GLC_NCPL). + + + + + integer + time + CLOCK_attributes + + wav coupling interval in seconds + set via WAV_NCPL in env_run.xml. + WAV_NCPL is the number of times the wav is coupled per NCPL_BASE_PERIOD + NCPL_BASE_PERIOD is also set in env_run.xml and is the base period + associated with NCPL coupling frequency, nad has valid values: hour,day,year,decade + + + + + integer + time + CLOCK_attributes + + esp run interval in seconds + esp_cpl_dt is the number of times the esp is run per NCPL_BASE_PERIOD + NCPL_BASE_PERIOD is set in env_run.xml and is the base period + associated with NCPL coupling frequency, nad has valid values: hour,day,year,decade + default value set by buildnml to be the pause interval if pause is active + otherwise, it is set to the shortest component coupling time + + + -999 + + + + + logical + time + CLOCK_attributes + + true => ESP component runs after driver 'pause cycle' If any + component 'pauses' (see PAUSE_OPTION, + PAUSE_N and DATA_ASSIMILATION_XXX XML + variables), the ESP component (if present) will be run to + process the component 'pause' (restart) files and set any + required 'resume' signals. If true, esp_cpl_dt and + esp_cpl_offset settings are ignored. default: true + + + .true. + + + + + char + time + CLOCK_attributes + NO_LEAP,GREGORIAN + + calendar in use. [NO_LEAP, GREOGORIAN]. + set by CALENDAR in env_build.xml + + + $CALENDAR + + + + + integer + time + CLOCK_attributes + + Run start date in yyyymmdd format, only used for startup and hybrid runs. + default: 00010101 + + + 00010101 + + + + + integer + time + CLOCK_attributes + + Start time-of-day in universal time (seconds), should be between zero and 86400 + default: 0 + + + $START_TOD + + + + + char + time + CLOCK_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + sets the run length with stop_n and stop_ymd + stop_option alarms are: + [none/never], turns option off + [nstep/s] , stops every stop_n nsteps , relative to current run start time + [nsecond/s] , stops every stop_n nseconds, relative to current run start time + [nminute/s] , stops every stop_n nminutes, relative to current run start time + [nhour/s] , stops every stop_n nhours , relative to current run start time + [nday/s] , stops every stop_n ndays , relative to current run start time + [nmonth/s] , stops every stop_n nmonths , relative to current run start time + [monthly/s] , stops every month , relative to current run start time + [nyear/s] , stops every stop_n nyears , relative to current run start time + [date] , stops at stop_ymd value + [ifdays0] , stops at stop_n calendar day value and seconds equal 0 + [end] , stops at end + + + $STOP_OPTION + + + + + integer + time + CLOCK_attributes + + Sets the run length with stop_option and stop_ymd + + + $STOP_N + + + + + integer + time + CLOCK_attributes + + date in yyyymmdd format, sets the run length with stop_option and stop_n, + can be in addition to stop_option and stop_n, negative value implies off + + + $STOP_DATE + + + + + integer + time + CLOCK_attributes + + Stop time-of-day in universal time (seconds), should be between zero and 86400 + default: 0 + + + 0 + + + + + char + time + CLOCK_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,monthly,nmonth,nyears,nyear,date,ifdays0,end + + sets the restart frequency with restart_n and restart_ymd + restart_option alarms are: + [none/never], turns option off + [nstep/s] , restarts every restart_n nsteps , relative to current run start time + [nsecond/s] , restarts every restart_n nseconds, relative to current run start time + [nminute/s] , restarts every restart_n nminutes, relative to current run start time + [nhour/s] , restarts every restart_n nhours , relative to current run start time + [nday/s] , restarts every restart_n ndays , relative to current run start time + [monthly/s] , restarts every month , relative to current run start time + [nmonth/s] , restarts every restart_n nmonths , relative to current run start time + [nyear/s] , restarts every restart_n nyears , relative to current run start time + [date] , restarts at restart_ymd value + [ifdays0] , restarts at restart_n calendar day value and seconds equal 0 + [end] , restarts at end + + + $REST_OPTION + + + + + integer + time + CLOCK_attributes + + Sets model restart writes with restart_option and restart_ymd (same options as stop_n) + + + $REST_N + + + + + integer + time + CLOCK_attributes + + Date in yyyymmdd format, sets model restart write date with rest_option and restart_n + default: STOP_N + + + $REST_DATE + + + + + integer + time + CLOCK_attributes + + Reference date in yyyymmdd format + default: 0 + + + 0 + + + + + integer + time + CLOCK_attributes + + Reference time of day in seconds + default: 0 + + + 0 + + + + + logical + time + CLOCK_attributes + + true => write restarts at end of run + forces a restart write at the end of the run in addition to any + setting associated with rest_option. default=true. this setting + will be set to false if restart_option is none or never. + default: false + + + .false. + + + + + char + time + CLOCK_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + coupler history snapshot option (used with history_n and history_ymd) + set by HIST_OPTION in env_run.xml. + history_option alarms are: + [none/never], turns option off + [nstep/s] , history snapshot every history_n nsteps , relative to current run start time + [nsecond/s] , history snapshot every history_n nseconds, relative to current run start time + [nminute/s] , history snapshot every history_n nminutes, relative to current run start time + [nhour/s] , history snapshot every history_n nhours , relative to current run start time + [nday/s] , history snapshot every history_n ndays , relative to current run start time + [monthly/s] , history snapshot every month , relative to current run start time + [nmonth/s] , history snapshot every history_n nmonths , relative to current run start time + [nyear/s] , history snapshot every history_n nyears , relative to current run start time + [date] , history snapshot at history_ymd value + [ifdays0] , history snapshot at history_n calendar day value and seconds equal 0 + [end] , history snapshot at end + + + $HIST_OPTION + + + + + integer + time + CLOCK_attributes + + sets coupler snapshot history file frequency (like restart_n) + set by HIST_N in env_run.xml. + + + $HIST_N + + + + + integer + time + CLOCK_attributes + + date associated with history_option date. yyyymmdd format. + set by HIST_DATE in env_run.xml. + + + $HIST_DATE + + + + + char + time + CLOCK_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + coupler time average history option (used with histavg_n and histavg_ymd) + set by AVGHIST_OPTION in env_run.xml. + histavg_option alarms are: + [none/never], turns option off + [nstep/s] , history snapshot every histavg_n nsteps , relative to current run start time + [nsecond/s] , history snapshot every histavg_n nseconds, relative to current run start time + [nminute/s] , history snapshot every histavg_n nminutes, relative to current run start time + [nhour/s] , history snapshot every histavg_n nhours , relative to current run start time + [nday/s] , history snapshot every histavg_n ndays , relative to current run start time + [monthly/s] , history snapshot every month , relative to current run start time + [nmonth/s] , history snapshot every histavg_n nmonths , relative to current run start time + [nyear/s] , history snapshot every histavg_n nyears , relative to current run start time + [date] , history snapshot at histavg_ymd value + [ifdays0] , history snapshot at histavg_n calendar day value and seconds equal 0 + [end] , history snapshot at end + + + $AVGHIST_OPTION + + + + + integer + time + CLOCK_attributes + + Sets coupler time-average history file frequency (like restart_option) + set by AVGHIST_N in env_run.xml. + + + $AVGHIST_N + + + + + integer + time + CLOCK_attributes + + date associated with histavg_option date. yyyymmdd format. + set by AVGHIST_DATE in env_run.xml. + + + $AVGHIST_DATE + + + + + char + time + CLOCK_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,monthly,nmonth,nyears,nyear,date,ifdays0,end + + sets the driver barrier frequency to sync models across all tasks with barrier_n and barrier_ymd + barrier_option alarms are like restart_option + default: never + + + $BARRIER_OPTION + + + + + integer + time + CLOCK_attributes + + Sets model barriers with barrier_option and barrier_ymd (same options as stop_n) + default: 1 + + + $BARRIER_N + + + + + integer + time + CLOCK_attributes + + Date in yyyymmdd format, sets model barriers date with barrier_option and barrier_n + + + $BARRIER_DATE + + + + + char + time + CLOCK_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + + Sets timing output file frequency (like rest_option but relative to run start date) + tprof_option alarms are: + [none/never], turns option off + [nstep/s] , every tprof_n nsteps , relative to current run start time + [nsecond/s] , every tprof_n nseconds, relative to current run start time + [nminute/s] , every tprof_n nminutes, relative to current run start time + [nhour/s] , every tprof_n nhours , relative to current run start time + [nday/s] , every tprof_n ndays , relative to current run start time + [monthly/s] , every month , relative to current run start time + [nmonth/s] , every tprof_n nmonths , relative to current run start time + [nyear/s] , every tprof_n nyears , relative to current run start time + [date] , at tprof_ymd value + [ifdays0] , at tprof_n calendar day value and seconds equal 0 + [end] , at end + + + never + + + + + integer + time + CLOCK_attributes + + Sets timing output file frequency (like restart_n) + + + -999 + + + + + integer + time + CLOCK_attributes + + yyyymmdd format, sets timing output file date (like restart_date) + + + -999 + + + + + char + time + CLOCK_attributes + none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear + + sets the pause frequency with pause_n + pause_option alarms are: + [none/never], turns option off + [nstep/s] , pauses every pause_n nsteps , relative to start or last pause time + [nsecond/s] , pauses every pause_n nseconds, relative to start or last pause time + [nminute/s] , pauses every pause_n nminutes, relative to start or last pause time + [nhour/s] , pauses every pause_n nhours , relative to start or last pause time + [nday/s] , pauses every pause_n ndays , relative to start or last pause time + [nmonth/s] , pauses every pause_n nmonths , relative to start or last pause time + [monthly/s] , pauses every month , relative to start or last pause time + [nyear/s] , pauses every pause_n nyears , relative to start or last pause time + + + $PAUSE_OPTION + + + + + integer + time + CLOCK_attributes + + Sets the pause frequency with pause_option + + + $PAUSE_N + + + + + logical + time + CLOCK_attributes + + Whether Pause signals are active for component atm + + + $PAUSE_ACTIVE_ATM + + + + + logical + time + CLOCK_attributes + + Whether Pause signals are active for component CPL + + + $PAUSE_ACTIVE_CPL + + + + + logical + time + CLOCK_attributes + + Whether Pause signals are active for component ocn + + + $PAUSE_ACTIVE_OCN + + + + + logical + time + CLOCK_attributes + + Whether Pause signals are active for component wav + + + $PAUSE_ACTIVE_WAV + + + + + logical + time + CLOCK_attributes + + Whether Pause signals are active for component glc + + + $PAUSE_ACTIVE_GLC + + + + + logical + time + CLOCK_attributes + + Whether Pause signals are active for component rof + + + $PAUSE_ACTIVE_ROF + + + + + logical + time + CLOCK_attributes + + Whether Pause signals are active for component ice + + + $PAUSE_ACTIVE_ICE + + + + + logical + time + CLOCK_attributes + + Whether Pause signals are active for component lnd + + + $PAUSE_ACTIVE_LND + + + + + + + + + integer + cime_pes + PELAYOUT_attributes + + The number of model instances in the executable + + + $NINST + + + + + integer + cime_pes + PELAYOUT_attributes + + the number of mpi tasks assigned to the atm components. + set by NTASKS_ATM in env_configure.xml. + + + $NTASKS_ATM + + + + + integer + cime_pes + PELAYOUT_attributes + + the number of threads per mpi task for the atm component. + set by NTHRDS_ATM in env_configure.xml. + + + $NTHRDS_ATM + + + + + integer + cime_pes + PELAYOUT_attributes + + the global mpi task rank of the root processor assigned to the atm component. + set by ROOTPE_ATM in env_configure.xml. + + + $ROOTPE_ATM + + + + + integer + cime_pes + PELAYOUT_attributes + + the mpi global processors stride associated with the mpi tasks for the atm component. + set by PSTRID_ATM in env_configure.xml. + + + $PSTRID_ATM + + + + + integer + cime_pes + PELAYOUT_attributes + + the number of mpi tasks assigned to the lnd components. + set by NTASKS_LND in env_configure.xml. + + + $NTASKS_LND + + + + + integer + cime_pes + PELAYOUT_attributes + + the number of threads per mpi task for the lnd component. + set by NTHRDS_LND in env_configure.xml. + + + $NTHRDS_LND + + + + + integer + cime_pes + PELAYOUT_attributes + + the global mpi task rank of the root processor assigned to the lnd component. + set by ROOTPE_LND in env_configure.xml. + + + $ROOTPE_LND + + + + + integer + cime_pes + PELAYOUT_attributes + + the mpi global processors stride associated with the mpi tasks for the lnd component. + set by PSTRID_LND in env_configure.xml. + + + $PSTRID_LND + + + + + integer + cime_pes + PELAYOUT_attributes + + the number of mpi tasks assigned to the ice components. + set by NTASKS_ICE in env_configure.xml. + + + $NTASKS_ICE + + + + + integer + cime_pes + PELAYOUT_attributes + + the number of threads per mpi task for the ice component. + set by NTHRDS_ICE in env_configure.xml. + + + $NTHRDS_ICE + + + + + integer + cime_pes + PELAYOUT_attributes + + the global mpi task rank of the root processor assigned to the ice component. + set by ROOTPE_ICE in env_configure.xml. + + + $ROOTPE_ICE + + + + + integer + cime_pes + PELAYOUT_attributes + + the mpi global processors stride associated with the mpi tasks for the ice component. + set by PSTRID_ICE in env_configure.xml. + + + $PSTRID_ICE + + + + + integer + cime_pes + PELAYOUT_attributes + + the number of mpi tasks assigned to the ocn components. + set by NTASKS_OCN in env_configure.xml. + + + $NTASKS_OCN + + + + + integer + cime_pes + PELAYOUT_attributes + + the number of threads per mpi task for the ocn component. + set by NTHRDS_OCN in env_configure.xml. + + + $NTHRDS_OCN + + + + + integer + cime_pes + PELAYOUT_attributes + + the global mpi task rank of the root processor assigned to the ocn component. + set by ROOTPE_OCN in env_configure.xml. + + + $ROOTPE_OCN + + + + + integer + cime_pes + PELAYOUT_attributes + + the mpi global processors stride associated with the mpi tasks for the ocn component. + set by PSTRID_OCN in env_configure.xml. default: 1 + + + $PSTRID_OCN + + + + + integer + cime_pes + PELAYOUT_attributes + + the number of mpi tasks assigned to the glc components. + set by NTASKS_GLC in env_configure.xml. + + + $NTASKS_GLC + + + + + integer + cime_pes + PELAYOUT_attributes + + the number of threads per mpi task for the glc component. + set by NTHRDS_GLC in env_configure.xml. + + + $NTHRDS_GLC + + + + + integer + cime_pes + PELAYOUT_attributes + + the global mpi task rank of the root processor assigned to the glc component. + set by ROOTPE_GLC in env_configure.xml. + + + $ROOTPE_GLC + + + + + integer + cime_pes + PELAYOUT_attributes + + the mpi global processors stride associated with the mpi tasks for the glc component. + set by PSTRID_GLC in env_configure.xml. + + + $PSTRID_GLC + + + + + integer + cime_pes + PELAYOUT_attributes + + the number of mpi tasks assigned to the wav components. + set by NTASKS_WAV in env_configure.xml. + + + $NTASKS_WAV + + + + + integer + cime_pes + PELAYOUT_attributes + + the number of threads per mpi task for the wav component. + set by NTHRDS_WAV in env_configure.xml. + + + $NTHRDS_WAV + + + + + integer + cime_pes + PELAYOUT_attributes + + the global mpi task rank of the root processor assigned to the wav component. + set by ROOTPE_WAV in env_configure.xml. + + + $ROOTPE_WAV + + + + + integer + cime_pes + PELAYOUT_attributes + + the mpi global processors stride associated with the mpi tasks for the wav component. + set by PSTRID_WAV in env_configure.xml. + + + $PSTRID_WAV + + + + + integer + cime_pes + PELAYOUT_attributes + + the number of mpi tasks assigned to the lnd components. + set by NTASKS_LND in env_configure.xml. + + + $NTASKS_ROF + + + + + integer + cime_pes + PELAYOUT_attributes + + the number of threads per mpi task for the lnd component. + set by NTHRDS_ROF in env_configure.xml. + + + $NTHRDS_ROF + + + + + integer + cime_pes + PELAYOUT_attributes + + the global mpi task rank of the root processor assigned to the lnd component. + set by ROOTPE_LND in env_configure.xml. + + + $ROOTPE_ROF + + + + + integer + cime_pes + PELAYOUT_attributes + + the mpi global processors stride associated with the mpi tasks for the lnd component. + set by PSTRID_LND in env_configure.xml. + + + $PSTRID_ROF + + + + + integer + cime_pes + PELAYOUT_attributes + + the number of mpi tasks assigned to the esp components. + set by NTASKS_ESP in env_configure.xml. + + + $NTASKS_ESP + + + + + integer + cime_pes + PELAYOUT_attributes + + the number of threads per mpi task for the esp component. + set by NTHRDS_ESP in env_configure.xml. + + + $NTHRDS_ESP + + + + + integer + cime_pes + PELAYOUT_attributes + + the global mpi task rank of the root processor assigned to the esp component. + set by ROOTPE_ESP in env_configure.xml. + + + $ROOTPE_ESP + + + + + integer + cime_pes + PELAYOUT_attributes + + the mpi global processors stride associated with the mpi tasks for the esp component. + set by PSTRID_ESP in env_configure.xml. + + + $PSTRID_ESP + + + + + integer + cime_pes + PELAYOUT_attributes + + the number of mpi tasks assigned to the cpl components. + set by NTASKS_CPL in env_configure.xml. + + + $NTASKS_CPL + + + + + integer + cime_pes + PELAYOUT_attributes + + the number of threads per mpi task for the cpl component. + set by NTHRDS_CPL in env_configure.xml. + + + $NTHRDS_CPL + + + + + integer + cime_pes + PELAYOUT_attributes + + the global mpi task rank of the root processor assigned to the cpl component. + set by ROOTPE_CPL in env_configure.xml. + + + $ROOTPE_CPL + + + + + integer + cime_pes + PELAYOUT_attributes + + the mpi global processors stride associated with the mpi tasks for the cpl component. + set by PSTRID_CPL in env_configure.xml. + + + $PSTRID_CPL + + + + + char + cime_pes + PELAYOUT_attributes + + Determines what ESMF log files (if any) are generated when + USE_ESMF_LIB is TRUE. + ESMF_LOGKIND_SINGLE: Use a single log file, combining messages from + all of the PETs. Not supported on some platforms. + ESMF_LOGKIND_MULTI: Use multiple log files — one per PET. + ESMF_LOGKIND_NONE: Do not issue messages to a log file. + By default, no ESMF log files are generated. + + + $ESMF_LOGFILE_KIND + + + + + + + + + + logical + performance + prof_inparm + + + + .true. + + + + + logical + performance + prof_inparm + + + + .false. + + + + + logical + performance + prof_inparm + + + + .false. + .true. + + + + + logical + performance + prof_inparm + + + + .false. + + + + + integer + performance + prof_inparm + + + + $TIMER_LEVEL + + + + + integer + performance + prof_inparm + + + + 0 + + + + + integer + performance + prof_inparm + + + + $TIMER_DETAIL + + + + + integer + performance + prof_inparm + + + + 4 + 2 + 1 + 3 + + + + + logical + performance + prof_inparm + + default: .false. + + + .false. + + + + + logical + performance + prof_inparm + + default: .false. + + + .false. + + + + + integer + performance + prof_inparm + + default: 1 + + + 1 + + + + + logical + performance + prof_inparm + + default: .false. + + + $PROFILE_PAPI_ENABLE + + + + + + + + + + char + performance + papi_inparm + + See gptl_papi.c for the list of valid values + + + PAPI_FP_OPS + + + + + char + performance + papi_inparm + + See gptl_papi.c for the list of valid values + + + PAPI_NO_CTR + + + + + char + performance + papi_inparm + + See gptl_papi.c for the list of valid values + + + PAPI_NO_CTR + + + + + char + performance + papi_inparm + + See gptl_papi.c for the list of valid values + + + PAPI_NO_CTR + + + + + + + + + logical + pio + pio_default_inparm + + future asynchronous IO capability (not currently supported). + If pio_async_interface is .true. or {component}_PIO_* variable is not set or set to -99 + the component variable will be set using the pio_* value. + default: .false. + + + $PIO_ASYNC_INTERFACE + + + + + integer + pio + pio_default_inparm + 0,1,2,3,4,5,6 + + pio debug level + valid values: 0,1,2,3,4,5,6 + + + $PIO_DEBUG_LEVEL + + + + + integer + pio + pio_default_inparm + + blocksize for pio box rearranger + + + $PIO_BLOCKSIZE + + + + + integer + pio + pio_default_inparm + + pio buffer size limit + + + $PIO_BUFFER_SIZE_LIMIT + + + + + char + pio + pio_default_inparm + p2p,coll,default + + pio rearranger communication type. + valid values: p2p, coll, default + + + $PIO_REARR_COMM_TYPE + + + + + char + pio + pio_default_inparm + 2denable,io2comp,comp2io,disable,default + + pio rearranger communication flow control direction. + + + $PIO_REARR_COMM_FCD + + + + + integer + pio + pio_default_inparm + + pio rearranger communication max pending req (comp2io) + + + $PIO_REARR_COMM_MAX_PEND_REQ_COMP2IO + + + + + logical + pio + pio_default_inparm + + pio rearranger communication option: Enable handshake (comp2io) + + + $PIO_REARR_COMM_ENABLE_HS_COMP2IO + + + + + logical + pio + pio_default_inparm + + pio rearranger communication option: Enable isends (comp2io) + + + $PIO_REARR_COMM_ENABLE_ISEND_COMP2IO + + + + + integer + pio + pio_default_inparm + + pio rearranger communication max pending req (io2comp) + + + $PIO_REARR_COMM_MAX_PEND_REQ_IO2COMP + + + + + logical + pio + pio_default_inparm + + pio rearranger communication option: Enable handshake (io2comp) + + + $PIO_REARR_COMM_ENABLE_HS_IO2COMP + + + + + logical + pio + pio_default_inparm + + pio rearranger communication option: Enable isends (io2comp) + default: .false. + + + $PIO_REARR_COMM_ENABLE_ISEND_IO2COMP + + + + + char(10) + drv_physics + default_settings + + List of files to merge together that contains drv_flds_in namelists + The paths are relative to the case directory. drv_flds_in include the namelists that + the driver reads and gives information on additional fields to be passed to different + components that need to look at the same data. + + + Buildconf/camconf/drv_flds_in,Buildconf/clmconf/drv_flds_in + + + + + logical + data_assimilation + CLOCK_attributes + + Whether Data Assimilation is on for component atm + + + $DATA_ASSIMILATION_ATM + + + + + logical + data_assimilation + CLOCK_attributes + + Whether Data Assimilation is on for component CPL + + + $DATA_ASSIMILATION_CPL + + + + + logical + data_assimilation + CLOCK_attributes + + Whether Data Assimilation is on for component ocn + + + $DATA_ASSIMILATION_OCN + + + + + logical + data_assimilation + CLOCK_attributes + + Whether Data Assimilation is on for component wav + + + $DATA_ASSIMILATION_WAV + + + + + logical + data_assimilation + CLOCK_attributes + + Whether Data Assimilation is on for component glc + + + $DATA_ASSIMILATION_GLC + + + + + logical + data_assimilation + CLOCK_attributes + + Whether Data Assimilation is on for component rof + + + $DATA_ASSIMILATION_ROF + + + + + logical + data_assimilation + CLOCK_attributes + + Whether Data Assimilation is on for component ice + + + $DATA_ASSIMILATION_ICE + + + + + logical + data_assimilation + CLOCK_attributes + + Whether Data Assimilation is on for component lnd + + + $DATA_ASSIMILATION_LND + + + + diff --git a/cime_config/namelist_definition_drv_flds.xml b/cime_config/namelist_definition_drv_flds.xml new file mode 100644 index 00000000..08847103 --- /dev/null +++ b/cime_config/namelist_definition_drv_flds.xml @@ -0,0 +1,148 @@ + + + + + + + + + + + + + + char + abs + drv_flds_in + megan_emis_nl + + File containing MEGAN emissions factors. Includes the list of MEGAN compounds that can be + used in the Comp_Name variable on the file. + + + + + char(100) + drv_flds_in + megan_emis_nl + + MEGAN specifier. This is in the form of: Chem-compound = megan_compound(s) + where megan_compound(s) can be the sum of megan compounds with a "+" between them. + In each equation, the item to the left of the equal sign is a CAM chemistry compound, the + items to the right are compounds known to the MEGAN model (single or combinations). + For example: megan_specifier = 'ISOP = isoprene', 'C10H16 = pinene_a + carene_3 + thujene_a' + + + + + logical + drv_flds_in + megan_emis_nl + + MEGAN mapped isoprene emissions factors switch + If TRUE then use mapped MEGAN emissions factors for isoprene. + + + + + char(150) + drv_flds_in + drv_physics + + List of possible MEGAN compounds to use + (the list used by the simulation is on the megan_factors_file as the Comp_Name) + + + + + + + + + char + dry-deposition + drydep_inparm + xactive_lnd,xactive_atm,table + + Where dry deposition is calculated (from land, atmosphere, or from a table) + This specifies the method used to calculate dry + deposition velocities of gas-phase chemical species. The available methods are: + 'table' - prescribed method in CAM + 'xactive_atm' - interactive method in CAM + 'xactive_lnd' - interactive method in CLM + + + + + char(300) + dry-deposition + drydep_inparm + + List of species that undergo dry deposition. + + + + + + + + + char(2) + nitrogen deposition + ndep_inparm + + List of nitrogen deposition fluxes to be sent from CAM to surfae models. + + + + + + + + + char + abs + Fire_emissions + fire_emis_nl + + File containing fire emissions factors. + + + + + char(100) + Fire_emissions + fire_emis_nl + + Fire emissions specifier. + + + + + logical + Fire_emissions + fire_emis_nl + + If ture fire emissions are input into atmosphere as elevated forcings. + Otherwise they are treated as surface emissions. + + + + + + + + + char + carma + carma_inparm + + List of fluxes needed by the CARMA model, from CLM to CAM. + + + + diff --git a/cime_config/namelist_definition_modelio.xml b/cime_config/namelist_definition_modelio.xml new file mode 100644 index 00000000..ea5d47f0 --- /dev/null +++ b/cime_config/namelist_definition_modelio.xml @@ -0,0 +1,206 @@ + + + + + + + + + + + + + + integer + pio + pio_inparm + + stride of tasks in pio used generically, component based value takes precedent. + + + $CPL_PIO_STRIDE + $ATM_PIO_STRIDE + $LND_PIO_STRIDE + $OCN_PIO_STRIDE + $ICE_PIO_STRIDE + $ROF_PIO_STRIDE + $GLC_PIO_STRIDE + $WAV_PIO_STRIDE + -99 + + + + + integer + pio + pio_inparm + + io task root in pio used generically, component based value takes precedent. + + + $CPL_PIO_ROOT + $ATM_PIO_ROOT + $LND_PIO_ROOT + $OCN_PIO_ROOT + $ICE_PIO_ROOT + $ROF_PIO_ROOT + $GLC_PIO_ROOT + $WAV_PIO_ROOT + -99 + + + + + integer + pio + pio_inparm + -99,1,2 + + Rearranger method for pio 1=box, 2=subset. + + + $CPL_PIO_REARRANGER + $ATM_PIO_REARRANGER + $LND_PIO_REARRANGER + $OCN_PIO_REARRANGER + $ICE_PIO_REARRANGER + $ROF_PIO_REARRANGER + $GLC_PIO_REARRANGER + $WAV_PIO_REARRANGER + -99 + + + + + integer + pio + pio_inparm + + number of io tasks in pio used generically, component based value takes precedent. + + + $CPL_PIO_NUMTASKS + $ATM_PIO_NUMTASKS + $LND_PIO_NUMTASKS + $OCN_PIO_NUMTASKS + $ICE_PIO_NUMTASKS + $ROF_PIO_NUMTASKS + $GLC_PIO_NUMTASKS + $WAV_PIO_NUMTASKS + -99 + + + + + char*64 + pio + pio_inparm + netcdf,pnetcdf,netcdf4p,netcdf4c,default + + io type in pio used generically, component based value takes precedent. + valid values: netcdf, pnetcdf, netcdf4p, netcdf4c, default + + + $CPL_PIO_TYPENAME + $ATM_PIO_TYPENAME + $LND_PIO_TYPENAME + $OCN_PIO_TYPENAME + $ICE_PIO_TYPENAME + $ROF_PIO_TYPENAME + $GLC_PIO_TYPENAME + $WAV_PIO_TYPENAME + nothing + + + + + char*64 + pio + pio_inparm + classic,64bit_offset,64bit_data + + format of netcdf files created by pio, ignored if + PIO_TYPENAME is netcdf4p or netcdf4c. 64bit_data only + supported in netcdf 4.4.0 or newer + + + $CPL_PIO_NETCDF_FORMAT + $ATM_PIO_NETCDF_FORMAT + $LND_PIO_NETCDF_FORMAT + $OCN_PIO_NETCDF_FORMAT + $ICE_PIO_NETCDF_FORMAT + $ROF_PIO_NETCDF_FORMAT + $GLC_PIO_NETCDF_FORMAT + $WAV_PIO_NETCDF_FORMAT + + + + + + + + + char*256 + modelio + modelio + input directory (no longer needed) + + UNSET + + + + + char*256 + modelio + modelio + directory for output log files + + UNSET + + + + + char*256 + modelio + modelio + name of component output log file + + UNSET + + + + diff --git a/cime_config/nuopc_runseq_A b/cime_config/nuopc_runseq_A new file mode 100644 index 00000000..580f5215 --- /dev/null +++ b/cime_config/nuopc_runseq_A @@ -0,0 +1,40 @@ +runSeq:: +@ocn_cpl_dt #ocean coupling step + MED med_phases_prep_ocn_accum_avg + MED med_connectors_prep_med2ocn + MED -> OCN :remapMethod=redist + @atm_cpl_dt # atmosphere coupling step + MED med_phases_prep_ocn_map + MED med_phases_aofluxes_run + MED med_phases_prep_ocn_merge + MED med_phases_prep_ocn_accum_fast + MED med_phases_ocnalb_run + MED med_phases_prep_ice + MED med_connectors_prep_med2ice + MED -> ICE :remapMethod=redist + MED med_phases_prep_rof_accum_fast + MED med_phases_prep_rof_avg + MED med_connectors_prep_med2rof + MED -> ROF :remapMethod=redist + ICE + ROF + ICE -> MED :remapMethod=redist + MED med_connectors_post_ice2med + MED med_fraction_set + ROF -> MED :remapMethod=redist + MED med_connectors_post_rof2med + MED med_phases_prep_atm + MED med_connectors_prep_med2atm + MED -> ATM :remapMethod=redist + ATM + ATM -> MED :remapMethod=redist + MED med_connectors_post_atm2med + MED med_phases_history_write + MED med_phases_profile + @ + OCN + OCN -> MED :remapMethod=redist + MED med_connectors_post_ocn2med + MED med_phases_restart_write +@ +:: diff --git a/cime_config/nuopc_runseq_ADLND b/cime_config/nuopc_runseq_ADLND new file mode 100644 index 00000000..b5960889 --- /dev/null +++ b/cime_config/nuopc_runseq_ADLND @@ -0,0 +1,11 @@ +runSeq:: +@lnd_cpl_dt # lnd coupling step + LND + LND -> MED :remapMethod=redist + MED med_fraction_set + MED med_connectors_post_lnd2med + MED med_phases_history_write + MED med_phases_profile + MED med_phases_restart_write +@ +:: \ No newline at end of file diff --git a/cime_config/nuopc_runseq_ADWAV b/cime_config/nuopc_runseq_ADWAV new file mode 100644 index 00000000..c582a6dc --- /dev/null +++ b/cime_config/nuopc_runseq_ADWAV @@ -0,0 +1,11 @@ +runSeq:: +@wav_cpl_dt # wave coupling step + WAV + WAV -> MED :remapMethod=redist + MED med_connectors_post_wav2med + MED med_fraction_set + MED med_phases_history_write + MED med_phases_profile + MED med_phases_restart_write +@ +:: diff --git a/cime_config/nuopc_runseq_B b/cime_config/nuopc_runseq_B new file mode 100644 index 00000000..79b4d8dd --- /dev/null +++ b/cime_config/nuopc_runseq_B @@ -0,0 +1,39 @@ +runSeq:: +@ocn_cpl_dt # ocean coupling step + MED med_phases_prep_ocn_accum_avg + MED med_connectors_prep_med2ocn + MED -> OCN :remapMethod=redist + @atm_cpl_dt # atmosphere coupling step + MED med_phases_prep_ocn_map + MED med_phases_aofluxes_run + MED med_phases_prep_ocn_merge + MED med_phases_prep_ocn_accum_fast + MED med_phases_ocnalb_run + MED med_phases_prep_lnd + MED med_connectors_prep_med2lnd + MED -> LND :remapMethod=redist + MED med_phases_prep_ice + MED med_connectors_prep_med2ice + MED -> ICE :remapMethod=redist + ICE + LND + ICE -> MED :remapMethod=redist + MED med_connectors_post_ice2med + MED med_fraction_set + LND -> MED :remapMethod=redist + MED med_connectors_post_lnd2med + MED med_phases_prep_atm + MED med_connectors_prep_med2atm + MED -> ATM :remapMethod=redist + ATM + ATM -> MED :remapMethod=redist + MED med_connectors_post_atm2med + MED med_phases_history_write + MED med_phases_profile + @ + OCN + OCN -> MED :remapMethod=redist + MED med_connectors_post_ocn2med + MED med_phases_restart_write +@ +:: diff --git a/cime_config/nuopc_runseq_C_G_D b/cime_config/nuopc_runseq_C_G_D new file mode 100644 index 00000000..1b1f1bca --- /dev/null +++ b/cime_config/nuopc_runseq_C_G_D @@ -0,0 +1,33 @@ +runSeq:: +@ocn_cpl_dt #ocean coupling step + MED med_phases_prep_ocn_accum_avg + MED med_connectors_prep_med2ocn + MED -> OCN :remapMethod=redist + @atm_cpl_dt # atmosphere coupling step + MED med_phases_prep_ocn_map + MED med_phases_aofluxes_run + MED med_phases_prep_ocn_merge + MED med_phases_prep_ocn_accum_fast + MED med_phases_ocnalb_run + MED med_phases_prep_ice + MED med_connectors_prep_med2ice + MED -> ICE :remapMethod=redist + ICE + ROF + ATM + ICE -> MED :remapMethod=redist + MED med_connectors_post_ice2med + MED med_fraction_set + ROF -> MED :remapMethod=redist + MED med_connectors_post_rof2med + ATM -> MED :remapMethod=redist + MED med_connectors_post_atm2med + MED med_phases_history_write + MED med_phases_profile + @ + OCN + OCN -> MED :remapMethod=redist + MED med_connectors_post_ocn2med + MED med_phases_restart_write +@ +:: diff --git a/cime_config/nuopc_runseq_F b/cime_config/nuopc_runseq_F new file mode 100644 index 00000000..2bd784fd --- /dev/null +++ b/cime_config/nuopc_runseq_F @@ -0,0 +1,39 @@ +runSeq:: +@ocn_cpl_dt #ocean coupling step + @atm_cpl_dt # atmosphere coupling step + MED med_phases_prep_ocn_accum_avg + MED med_connectors_prep_med2ocn + MED -> OCN :remapMethod=redist + MED med_phases_prep_lnd + MED med_connectors_prep_med2lnd + MED -> LND :remapMethod=redist + MED med_phases_prep_ice + MED med_connectors_prep_med2ice + MED -> ICE :remapMethod=redist + ICE + LND + OCN + OCN -> MED :remapMethod=redist + MED med_connectors_post_ocn2med + ICE -> MED :remapMethod=redist + MED med_connectors_post_ice2med + MED med_fraction_set + MED med_phases_prep_ocn_map + MED med_phases_aofluxes_run + MED med_phases_prep_ocn_merge + MED med_phases_prep_ocn_accum_fast + MED med_phases_ocnalb_run + LND -> MED :remapMethod=redist + MED med_connectors_post_lnd2med + MED med_phases_prep_atm + MED med_connectors_prep_med2atm + MED -> ATM :remapMethod=redist + ATM + ATM -> MED :remapMethod=redist + MED med_connectors_post_atm2med + MED med_phases_history_write + MED med_phases_profile + @ + MED med_phases_restart_write +@ +:: \ No newline at end of file diff --git a/cime_config/nuopc_runseq_I b/cime_config/nuopc_runseq_I new file mode 100644 index 00000000..c8b3d4cf --- /dev/null +++ b/cime_config/nuopc_runseq_I @@ -0,0 +1,17 @@ +runSeq:: +@atm_cpl_dt # atmosphere coupling step + MED med_phases_prep_lnd + MED med_connectors_prep_med2lnd + MED -> LND :remapMethod=redist + LND + LND -> MED :remapMethod=redist + MED med_connectors_post_lnd2med + MED med_fraction_set + ATM + ATM -> MED :remapMethod=redist + MED med_connectors_post_atm2med + MED med_phases_history_write + MED med_phases_profile + MED med_phases_restart_write +@ +:: diff --git a/cime_config/nuopc_runseq_I_mosart b/cime_config/nuopc_runseq_I_mosart new file mode 100644 index 00000000..57cd78fe --- /dev/null +++ b/cime_config/nuopc_runseq_I_mosart @@ -0,0 +1,25 @@ +runSeq:: +@rof_cpl_dt # rof coupling step + MED med_phases_prep_rof_avg + MED med_connectors_prep_med2rof + MED -> ROF :remapMethod=redist + ROF + ROF -> MED :remapMethod=redist + @atm_cpl_dt # atmosphere coupling step + MED med_phases_prep_lnd + MED med_connectors_prep_med2lnd + MED -> LND :remapMethod=redist + LND + LND -> MED :remapMethod=redist + MED med_connectors_post_lnd2med + MED med_phases_prep_rof_accum_fast + ATM + ATM -> MED :remapMethod=redist + MED med_connectors_post_atm2med + MED med_phases_profile + @ + MED med_connectors_post_rof2med + MED med_phases_history_write + MED med_phases_restart_write +@ +:: diff --git a/cime_config/nuopc_runseq_NEMS b/cime_config/nuopc_runseq_NEMS new file mode 100644 index 00000000..63475e13 --- /dev/null +++ b/cime_config/nuopc_runseq_NEMS @@ -0,0 +1,32 @@ +runSeq:: +@ocn_cpl_dt #slow coupling step (ocean) + MED med_phases_prep_ocn_accum_avg + MED med_connectors_prep_med2ocn + MED -> OCN :remapMethod=redist + OCN + @atm_cpl_dt # fast coupling step (atm, ice) + MED med_phases_prep_atm + MED med_connectors_prep_med2atm + MED -> ATM :remapMethod=redist + ATM + ATM -> MED :remapMethod=redist + MED med_connectors_post_atm2med + MED med_phases_prep_ice + MED med_connectors_prep_med2ice + MED -> ICE :remapMethod=redist + ICE + ICE -> MED :remapMethod=redist + MED med_connectors_post_ice2med + MED med_fraction_set + MED med_phases_prep_ocn_map + MED med_phases_aofluxes_run + MED med_phases_prep_ocn_merge + MED med_phases_prep_ocn_accum_fast + MED med_phases_history_write + MED med_phases_profile + @ + OCN -> MED :remapMethod=redist + MED med_connectors_post_ocn2med + MED med_phases_restart_write +@ +:: diff --git a/cime_config/nuopc_runseq_NEMS.cold b/cime_config/nuopc_runseq_NEMS.cold new file mode 100644 index 00000000..9634191c --- /dev/null +++ b/cime_config/nuopc_runseq_NEMS.cold @@ -0,0 +1,32 @@ +runSeq:: +@ocn_cpl_dt #slow coupling step (ocean) + @atm_cpl_dt # fast coupling step (atm, ice) + MED med_phases_prep_atm + MED med_connectors_prep_med2atm + MED -> ATM :remapMethod=redist + ATM + ATM -> MED :remapMethod=redist + MED med_connectors_post_atm2med + MED med_phases_prep_ice + MED med_connectors_prep_med2ice + MED -> ICE :remapMethod=redist + ICE + ICE -> MED :remapMethod=redist + MED med_connectors_post_ice2med + MED med_fraction_set + MED med_phases_prep_ocn_map + MED med_phases_aofluxes_run + MED med_phases_prep_ocn_merge + MED med_phases_prep_ocn_accum_fast + MED med_phases_history_write + MED med_phases_profile + @ + MED med_phases_prep_ocn_accum_avg + MED med_connectors_prep_med2ocn + MED -> OCN :remapMethod=redist + OCN + OCN -> MED :remapMethod=redist + MED med_connectors_post_ocn2med + MED med_phases_restart_write +@ +:: diff --git a/cime_config/nuopc_runseq_NEMS.warm b/cime_config/nuopc_runseq_NEMS.warm new file mode 100644 index 00000000..a26dbcf5 --- /dev/null +++ b/cime_config/nuopc_runseq_NEMS.warm @@ -0,0 +1,32 @@ +runSeq:: +@ocn_cpl_dt #slow coupling step (ocean) + MED med_phases_prep_ocn_accum_avg + MED med_connectors_prep_med2ocn + MED -> OCN :remapMethod=redist + OCN + @atm_cpl_dt # fast coupling step (atm, ice) + MED med_phases_prep_atm + MED med_phases_prep_ice + MED med_connectors_prep_med2atm + MED -> ATM :remapMethod=redist + MED med_connectors_prep_med2ice + MED -> ICE :remapMethod=redist + ATM + ICE + ATM -> MED :remapMethod=redist + MED med_connectors_post_atm2med + ICE -> MED :remapMethod=redist + MED med_connectors_post_ice2med + MED med_fraction_set + MED med_phases_prep_ocn_map + MED med_phases_aofluxes_run + MED med_phases_prep_ocn_merge + MED med_phases_prep_ocn_accum_fast + MED med_phases_history_write + MED med_phases_profile + @ + OCN -> MED :remapMethod=redist + MED med_connectors_post_ocn2med + MED med_phases_restart_write +@ +:: diff --git a/cime_config/nuopc_runseq_Q b/cime_config/nuopc_runseq_Q new file mode 100644 index 00000000..16a7ca3d --- /dev/null +++ b/cime_config/nuopc_runseq_Q @@ -0,0 +1,27 @@ +runSeq:: + @ocn_cpl_dt #ocean coupling step + @atm_cpl_dt # atmosphere coupling step + MED med_phases_prep_ocn_accum_avg + MED med_connectors_prep_med2ocn + MED -> OCN :remapMethod=redist + OCN + OCN -> MED :remapMethod=redist + MED med_connectors_post_ocn2med + MED med_fraction_set + MED med_phases_prep_ocn_map + MED med_phases_aofluxes_run + MED med_phases_prep_ocn_merge + MED med_phases_prep_ocn_accum_fast + MED med_phases_ocnalb_run + MED med_phases_prep_atm + MED med_connectors_prep_med2atm + MED -> ATM :remapMethod=redist + ATM + ATM -> MED :remapMethod=redist + MED med_connectors_post_atm2med + MED med_phases_history_write + MED med_phases_profile + @ + MED med_phases_restart_write +@ +:: diff --git a/cime_config/nuopc_runseq_X b/cime_config/nuopc_runseq_X new file mode 100644 index 00000000..48ec4588 --- /dev/null +++ b/cime_config/nuopc_runseq_X @@ -0,0 +1,59 @@ +runSeq:: +@ocn_cpl_dt #ocean coupling step + MED med_phases_prep_ocn_accum_avg + MED med_connectors_prep_med2ocn + MED -> OCN :remapMethod=redist + @atm_cpl_dt # atmosphere coupling step + MED med_phases_prep_ocn_map + MED med_phases_aofluxes_run + MED med_phases_prep_ocn_merge + MED med_phases_prep_ocn_accum_fast + MED med_phases_ocnalb_run + MED med_phases_prep_lnd + MED med_connectors_prep_med2lnd + MED -> LND :remapMethod=redist + MED med_phases_prep_ice + MED med_connectors_prep_med2ice + MED -> ICE :remapMethod=redist + MED med_phases_prep_wav + MED med_connectors_prep_med2wav + MED -> WAV :remapMethod=redist + MED med_phases_prep_rof_accum_fast + MED med_phases_prep_rof_avg + MED med_connectors_prep_med2rof + MED -> ROF :remapMethod=redist + ICE + LND + ROF + WAV + ICE -> MED :remapMethod=redist + MED med_connectors_post_ice2med + MED med_fraction_set + LND -> MED :remapMethod=redist + MED med_connectors_post_lnd2med + ROF -> MED :remapMethod=redist + MED med_connectors_post_rof2med + MED med_phases_prep_glc + MED med_connectors_prep_med2glc + MED -> GLC :remapMethod=redist + MED med_phases_prep_atm + MED med_connectors_prep_med2atm + MED -> ATM :remapMethod=redist + ATM + GLC + WAV -> MED :remapMethod=redist + MED med_connectors_post_wav2med + GLC -> MED :remapMethod=redist + MED med_connectors_post_glc2med + ATM -> MED :remapMethod=redist + MED med_connectors_post_atm2med + MED med_phases_history_write + MED med_phases_profile + @ + OCN + OCN -> MED :remapMethod=redist + MED med_connectors_post_ocn2med + MED med_phases_restart_write +@ +:: + diff --git a/cime_config/nuopc_runseq_default b/cime_config/nuopc_runseq_default new file mode 100644 index 00000000..1611e712 --- /dev/null +++ b/cime_config/nuopc_runseq_default @@ -0,0 +1,57 @@ +runSeq:: +@ocn_cpl_dt #ocean coupling step + MED med_phases_prep_ocn_accum_avg + MED med_connectors_prep_med2ocn + MED -> OCN :remapMethod=redist + @atm_cpl_dt # atmosphere coupling step + MED med_phases_prep_ocn_map + MED med_phases_aofluxes_run + MED med_phases_prep_ocn_merge + MED med_phases_prep_ocn_accum_fast + MED med_phases_ocnalb_run + MED med_phases_prep_lnd + MED med_connectors_prep_med2lnd + MED -> LND :remapMethod=redist + MED med_phases_prep_ice + MED med_connectors_prep_med2ice + MED -> ICE :remapMethod=redist + MED med_phases_prep_wav + MED med_connectors_prep_med2wav + MED -> WAV :remapMethod=redist + MED med_phases_prep_rof + MED med_connectors_prep_med2rof + MED -> ROF :remapMethod=redist + ICE + LND + ROF + WAV + ICE -> MED :remapMethod=redist + MED med_connectors_post_ice2med + MED med_fraction_set + LND -> MED :remapMethod=redist + MED med_connectors_post_lnd2med + ROF -> MED :remapMethod=redist + MED med_connectors_post_rof2med + MED med_phases_prep_glc + MED med_connectors_prep_med2glc + MED -> GLC :remapMethod=redist + MED med_phases_prep_atm + MED med_connectors_prep_med2atm + MED -> ATM :remapMethod=redist + ATM + GLC + WAV -> MED :remapMethod=redist + MED med_connectors_post_wav2med + GLC -> MED :remapMethod=redist + MED med_connectors_post_glc2med + ATM -> MED :remapMethod=redist + MED med_connectors_post_atm2med + MED med_phases_history_write + MED med_phases_profile + @ + OCN + OCN -> MED :remapMethod=redist + MED med_connectors_post_ocn2med + MED med_phases_restart_write +@ +:: \ No newline at end of file diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml new file mode 100644 index 00000000..6dd42979 --- /dev/null +++ b/cime_config/testdefs/testlist_drv.xml @@ -0,0 +1,429 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/cime_config/testdefs/testmods_dirs/drv/5steps/shell_commands b/cime_config/testdefs/testmods_dirs/drv/5steps/shell_commands new file mode 100644 index 00000000..c72c4cfb --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/drv/5steps/shell_commands @@ -0,0 +1,2 @@ +./xmlchange STOP_OPTION="nsteps" + diff --git a/cime_config/testdefs/testmods_dirs/drv/default/shell_commands b/cime_config/testdefs/testmods_dirs/drv/default/shell_commands new file mode 100755 index 00000000..180e38db --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/drv/default/shell_commands @@ -0,0 +1,2 @@ +./xmlchange HIST_OPTION=ndays +./xmlchange HIST_N=1 diff --git a/cime_config/testdefs/testmods_dirs/drv/glcnec10/include_user_mods b/cime_config/testdefs/testmods_dirs/drv/glcnec10/include_user_mods new file mode 100644 index 00000000..fe0e18cf --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/drv/glcnec10/include_user_mods @@ -0,0 +1 @@ +../default diff --git a/cime_config/testdefs/testmods_dirs/drv/glcnec10/shell_commands b/cime_config/testdefs/testmods_dirs/drv/glcnec10/shell_commands new file mode 100644 index 00000000..be4e4e58 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/drv/glcnec10/shell_commands @@ -0,0 +1 @@ +./xmlchange GLC_NEC=10 \ No newline at end of file diff --git a/cime_config/testdefs/testmods_dirs/drv/som/shell_commands b/cime_config/testdefs/testmods_dirs/drv/som/shell_commands new file mode 100644 index 00000000..f3a70e7e --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/drv/som/shell_commands @@ -0,0 +1,2 @@ +./xmlchange DOCN_SOM_FILENAME="pop_frc.1x1d.090130.nc" + diff --git a/cime_config/user_nl_cpl b/cime_config/user_nl_cpl new file mode 100644 index 00000000..a2095360 --- /dev/null +++ b/cime_config/user_nl_cpl @@ -0,0 +1,19 @@ +!------------------------------------------------------------------------ +! Users should ONLY USE user_nl_cpl to change namelists variables +! for namelist variables in drv_in (except for the ones below) and +! any keyword/values in seq_maps.rc +! Users should add ALL user specific namelist and seq_maps.rc changes below +! using the following syntax +! namelist_var = new_namelist_value +! or +! mapname = new_map_name +! For example to change the default value of ocn2atm_fmapname to 'foo' use +! ocn2atm_fmapname = 'foo' +! +! Note that some namelist variables MAY NOT be changed in user_nl_cpl - +! they are defined in a $CASEROOT xml file and must be changed with +! xmlchange. +! +! For example, rather than set username to 'foo' in user_nl_cpl, call +! ./xmlchange USER=foo +!------------------------------------------------------------------------ diff --git a/src/drivers/cime/ensemble_driver.F90 b/src/drivers/cime/ensemble_driver.F90 new file mode 100644 index 00000000..1b78f6f4 --- /dev/null +++ b/src/drivers/cime/ensemble_driver.F90 @@ -0,0 +1,318 @@ +module Ensemble_driver + + !----------------------------------------------------------------------------- + ! Code that creates the ensemble driver layer above the esm driver. + ! The ensmeble driver is configured to run a single clock cycle in nuopc with time step + ! length of stop_time - start_time. It's purpose is to instantiate NINST copies of the + ! esm driver and its components layed out concurently across mpi tasks. + !----------------------------------------------------------------------------- + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag, CL + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use med_internalstate_mod , only : mastertask + implicit none + private + + public :: SetServices + private :: SetModelServices + + character(*),parameter :: u_FILE_u = __FILE__ + +!================================================================================ + contains +!================================================================================ + + subroutine SetServices(ensemble_driver, rc) + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSpecialize + use NUOPC_Driver , only : driver_routine_SS => SetServices + use NUOPC_Driver , only : ensemble_label_SetModelServices => label_SetModelServices + use ESMF , only : ESMF_GridComp, ESMF_Config, ESMF_GridCompSet, ESMF_ConfigLoadFile + use ESMF , only : ESMF_ConfigCreate + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO + type(ESMF_GridComp) :: ensemble_driver + integer, intent(out) :: rc + + ! local variables + type(ESMF_Config) :: config + integer :: dbrc + character(len=*), parameter :: subname = "(ensemble_driver.F90:SetServices)" + !--------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + ! NUOPC_Driver registers the generic methods + call NUOPC_CompDerive(ensemble_driver, driver_routine_SS, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! attach specializing method(s) + call NUOPC_CompSpecialize(ensemble_driver, specLabel=ensemble_label_SetModelServices, & + specRoutine=SetModelServices, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create, open and set the config + config = ESMF_ConfigCreate(rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ConfigLoadFile(config, "nuopc.runconfig", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_GridCompSet(ensemble_driver, config=config, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine SetServices + + !================================================================================ + + subroutine SetModelServices(ensemble_driver, rc) + use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_Config, ESMF_Clock, ESMF_VMGet + use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_ConfigGetAttribute + use ESMF , only : ESMF_ConfigGetLen, ESMF_RC_NOT_VALID, ESMF_LogFoundAllocError + use ESMF , only : ESMF_LogSetError, ESMF_LogWrite, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_GridCompSet, ESMF_SUCCESS, ESMF_METHOD_INITIALIZE, ESMF_RC_ARG_BAD + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd + use NUOPC_Driver , only : NUOPC_DriverAddComp + use esm, only : ESMSetServices => SetServices, ReadAttributes +! use pio_interface, only : PIOSetServices => SetServices + use shr_nuopc_time_mod , only : shr_nuopc_time_clockInit + use med_internalstate_mod , only : logunit ! initialized here + use shr_log_mod , only : shrloglev=>shr_log_level, shrlogunit=> shr_log_unit + use shr_file_mod , only : shr_file_getUnit, shr_file_getLoglevel + use shr_file_mod , only : shr_file_setloglevel, shr_file_setlogunit + + type(ESMF_GridComp) :: ensemble_driver + integer, intent(out) :: rc + + ! local variables + type(ESMF_VM) :: vm + type(ESMF_GridComp) :: driver, gridcomptmp + type(ESMF_Config) :: config + integer :: n, n1, stat + integer, pointer :: petList(:) + character(len=20) :: model, prefix + integer :: petCount, i + integer :: localPet + integer :: rootpe_med + logical :: is_set + character(len=512) :: diro + character(len=512) :: logfile + integer :: global_comm + integer :: cpl_rootpe + logical :: iamroot_med ! mediator masterproc + logical :: read_restart + integer :: dbrc + integer :: inst + integer :: number_of_members + integer :: ntasks_per_member + character(CL) :: start_type ! Type of startup + character(len=7) :: drvrinst + character(len=5) :: inst_suffix + character(len=CL) :: msgstr + character(len=CL) :: cvalue + character(len=*) , parameter :: start_type_start = "startup" + character(len=*) , parameter :: start_type_cont = "continue" + character(len=*) , parameter :: start_type_brnch = "branch" + character(len=*) , parameter :: subname = "(ensemble_driver.F90:SetModelServices)" + + !------------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + call ESMF_GridCompGet(ensemble_driver, config=config, vm=vm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=localPet, PetCount=PetCount, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------------------------------- + ! Initialize clocks + !------------------------------------------- + call ReadAttributes(ensemble_driver, config, "ALLCOMP_attributes::", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ReadAttributes(ensemble_driver, config, "CLOCK_attributes::", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ReadAttributes(ensemble_driver, config, "PELAYOUT_attributes::", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(ensemble_driver, name="cpl_rootpe", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) cpl_rootpe + + ! Check valid values of start type + call NUOPC_CompAttributeGet(ensemble_driver, name="start_type", value=start_type, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if ((trim(start_type) /= start_type_start) .and. & + (trim(start_type) /= start_type_cont ) .and. & + (trim(start_type) /= start_type_brnch)) then + write (msgstr, *) subname//': start_type invalid = '//trim(start_type) + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return + end if + + call InitRestart(ensemble_driver, read_restart, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(ensemble_driver, name="ninst", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue, *) number_of_members + !------------------------------------------- + ! Extract the config object from the ensemble_driver + !------------------------------------------- + ntasks_per_member = PetCount/number_of_members + if(ntasks_per_member*number_of_members .ne. PetCount) then + write (msgstr,'(a,i5,a,i3,a,i3,a)') "PetCount (",PetCount,& + ") must be evenly divisable by number of members (",number_of_members,")" + call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + + allocate(petList(ntasks_per_member)) + + call NUOPC_CompAttributeGet(ensemble_driver, name='cpl_rootpe', value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue, *) rootpe_med + + do inst=1,number_of_members + + petList(1) = (inst-1) * ntasks_per_member + do n=2,ntasks_per_member + petList(n) = petList(n-1) + 1 + enddo + write(drvrinst,'(a,i4.4)') "ESM",inst + call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=gridcomptmp, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (localpet >= petlist(1) .and. localpet <= petlist(ntasks_per_member)) then + driver = gridcomptmp + if(number_of_members > 1) then + call NUOPC_CompAttributeAdd(driver, attrList=(/'inst_suffix'/), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + write(inst_suffix,'(a,i4.4)') '_',inst + call NUOPC_CompAttributeSet(driver, name='inst_suffix', value=inst_suffix, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else + inst_suffix = '' + endif + write(cvalue,*) read_restart + call NUOPC_CompAttributeAdd(driver, attrList=(/'read_restart'/), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(driver, name='read_restart', value=trim(cvalue), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ReadAttributes(driver, config, "MED_attributes::", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ReadAttributes(driver, config, "CLOCK_attributes::", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ReadAttributes(driver, config, "MED_modelio"//trim(inst_suffix)//"::", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! Set the mediator log to the MED task 0 + if (mod(localPet,ntasks_per_member)==cpl_rootpe) then + call NUOPC_CompAttributeGet(driver, name="diro", value=diro, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(driver, name="logfile", value=logfile, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + logunit = shr_file_getUnit() + open(logunit,file=trim(diro)//"/"//trim(logfile)) + mastertask = .true. + else + logUnit = shrlogunit + mastertask = .false. + endif + call shr_file_getLogLevel(shrloglev) + call shr_file_setLogLevel(max(shrloglev,1)) + call shr_file_setLogUnit (logunit) + endif + enddo + call shr_nuopc_time_clockInit(ensemble_driver, driver, logunit, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + deallocate(petList) + + end subroutine SetModelServices + + subroutine InitRestart(ensemble_driver, read_restart, rc) + + !----------------------------------------------------- + ! Determine if will restart and read pointer file + ! if appropriate + !----------------------------------------------------- + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_SUCCESS + use ESMF , only : ESMF_LogSetError, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_RC_NOT_VALID + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd + ! input/output variables + type(ESMF_GridComp) , intent(inout) :: ensemble_driver + logical , intent(out) :: read_restart ! read the restart file, based on start_type + integer , intent(out) :: rc + + ! local variables + character(len=CL) :: cvalue ! temporary + integer :: ierr ! error return + + character(len=CL) :: restart_file ! Full archive path to restart file + character(len=CL) :: restart_pfile ! Restart pointer file + character(len=CL) :: rest_case_name ! Short case identification + character(len=CL) :: start_type ! Type of startup + character(len=CL) :: msgstr + character(len=*) , parameter :: start_type_start = "startup" + character(len=*) , parameter :: start_type_cont = "continue" + character(len=*) , parameter :: start_type_brnch = "branch" + character(len=*) , parameter :: sp_str = 'str_undefined' + integer :: dbrc + character(len=*) , parameter :: subname = "(esm.F90:InitRestart)" + !------------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + !----------------------------------------------------- + ! Carry out restart if appropriate + !----------------------------------------------------- + + ! First Determine if restart is read + call NUOPC_CompAttributeGet(ensemble_driver, name='start_type', value=start_type, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Check valid values of start type + + if ((trim(start_type) /= start_type_start) .and. & + (trim(start_type) /= start_type_cont ) .and. & + (trim(start_type) /= start_type_brnch)) then + write (msgstr, *) subname//': start_type invalid = '//trim(start_type) + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return + end if + + !TODO: this is hard-wired to CIME start/continue types in terms of gcomp + read_restart = .false. + if (trim(start_type) == trim(start_type_cont) .or. trim(start_type) == trim(start_type_brnch)) then + read_restart = .true. + endif + + ! Add rest_case_name and read_restart to ensemble_driver attributes + call NUOPC_CompAttributeAdd(ensemble_driver, attrList=(/'rest_case_name','read_restart'/), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + rest_case_name = ' ' + call NUOPC_CompAttributeSet(ensemble_driver, name='rest_case_name', value=rest_case_name, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + write(cvalue,*) read_restart + call NUOPC_CompAttributeSet(ensemble_driver, name='read_restart', value=trim(cvalue), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine InitRestart + +end module ENSEMBLE_DRIVER diff --git a/src/drivers/cime/esm.F90 b/src/drivers/cime/esm.F90 new file mode 100644 index 00000000..5735ef79 --- /dev/null +++ b/src/drivers/cime/esm.F90 @@ -0,0 +1,1626 @@ +module ESM + + !----------------------------------------------------------------------------- + ! Code that specializes generic ESM Component code. + !----------------------------------------------------------------------------- + + use ESMF , only : ESMF_Clock + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_utils_mod , only : shr_nuopc_memcheck + use shr_kind_mod , only : SHR_KIND_R8, SHR_KIND_CS, SHR_KIND_CL + use shr_log_mod , only : shr_log_Unit, shr_log_Level + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use med_internalstate_mod , only : logunit, loglevel, mastertask, med_id + + implicit none + private + + character(len=512) :: msgstr + integer :: componentCount + character(len=8) :: atm_present, lnd_present, ocn_present + character(len=8) :: ice_present, rof_present, wav_present + character(len=8) :: glc_present, med_present + character(*), parameter :: nlfilename = "drv_in" ! input namelist filename + character(*), parameter :: u_FILE_u = & + __FILE__ + + public :: SetServices + public :: ReadAttributes ! used in ensemble_driver + + private :: SetModelServices + private :: SetRunSequence + private :: ModifyCplLists + private :: IsRestart + private :: InitRestart + private :: InitAttributes + private :: CheckAttributes + private :: AddAttributes + private :: InitAdvertize + private :: esm_init_pelayout + private :: esm_finalize + private :: pretty_print_nuopc_freeformat + +!================================================================================ +contains +!================================================================================ + + subroutine SetServices(driver, rc) + + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSpecialize, NUOPC_CompSetInternalEntryPoint + use NUOPC_Driver , only : driver_routine_SS => SetServices + use NUOPC_Driver , only : driver_label_SetModelServices => label_SetModelServices + use NUOPC_Driver , only : driver_label_SetRunSequence => label_SetRunSequence + use NUOPC_Driver , only : driver_label_Finalize => label_Finalize + use ESMF , only : ESMF_GridComp, ESMF_Config, ESMF_GridCompSet, ESMF_ConfigLoadFile + use ESMF , only : ESMF_METHOD_INITIALIZE + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO + + ! input/output variables + type(ESMF_GridComp) :: driver + integer, intent(out) :: rc + + ! local variables + integer :: dbrc + type(ESMF_Config) :: runSeq + character(len=*), parameter :: subname = "(esm.F90:SetServices)" + !--------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + ! NUOPC_Driver registers the generic methods + call NUOPC_CompDerive(driver, driver_routine_SS, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! attach specializing method(s) + call NUOPC_CompSpecialize(driver, specLabel=driver_label_SetModelServices, & + specRoutine=SetModelServices, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSpecialize(driver, specLabel=driver_label_SetRunSequence, & + specRoutine=SetRunSequence, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! register an internal initialization method + call NUOPC_CompSetInternalEntryPoint(driver, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv03p2"/), userRoutine=ModifyCplLists, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! + ! This prevents the driver trying to "auto" connect to the ensemble_driver + ! by default the FieldTransferPolicy is "transferall" and we need "transfernone" + ! + call NUOPC_CompSetInternalEntryPoint(driver, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv05p1"/), userRoutine=InitAdvertize, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Set a finalize method + call NUOPC_CompSpecialize(driver, specLabel=driver_label_Finalize, & + specRoutine=esm_finalize, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create, open and set the config + + call ESMF_GridCompSet(driver, configFile="nuopc.runconfig", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine SetServices + + !================================================================================ + + subroutine SetModelServices(driver, rc) + + use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_Config, ESMF_VMBarrier + use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_ConfigGetAttribute + use ESMF , only : ESMF_ConfigGetLen, ESMF_RC_NOT_VALID, ESMF_LogFoundAllocError + use ESMF , only : ESMF_LogSetError, ESMF_LogWrite, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_GridCompSet, ESMF_SUCCESS, ESMF_METHOD_INITIALIZE + use ESMF , only : ESMF_VMisCreated, ESMF_GridCompIsPetLocal + use ESMF , only : ESMF_RC_FILE_OPEN, ESMF_RC_FILE_READ + use ESMF , only : ESMF_AttributeUpdate, ESMF_VMBroadcast + use ESMF , only : ESMF_MethodAdd + use NUOPC , only : NUOPC_CompSetInternalEntryPoint, NUOPC_CompAttributeGet + use NUOPC , only : NUOPC_CompAttributeAdd, NUOPC_CompAttributeSet + use NUOPC_Driver , only : NUOPC_DriverAddComp, NUOPC_DriverGetComp + + use shr_nuopc_methods_mod , only : shr_nuopc_methods_Clock_TimePrint + use shr_file_mod , only : shr_file_setLogunit, shr_file_getunit + use med , only : med_SS => SetServices + use atm_comp_nuopc , only : ATMSetServices => SetServices + use ice_comp_nuopc , only : ICESetServices => SetServices + use lnd_comp_nuopc , only : LNDSetServices => SetServices + use ocn_comp_nuopc , only : OCNSetServices => SetServices + use wav_comp_nuopc , only : WAVSetServices => SetServices + use rof_comp_nuopc , only : ROFSetServices => SetServices + use glc_comp_nuopc , only : GLCSetServices => SetServices + use pio , only : pio_file_is_open, pio_closefile, file_desc_t + use perf_mod , only : t_initf + use shr_mem_mod , only : shr_mem_init + use shr_log_mod , only : shrlogunit=> shr_log_unit + + ! input/output variables + type(ESMF_GridComp) :: driver + integer, intent(out) :: rc + + ! local variables + type(ESMF_VM) :: vm + type(ESMF_Config) :: config + integer :: n, i, stat + character(len=20) :: model, prefix + integer :: localPet, medpet + character(SHR_KIND_CL) :: meminitStr + integer :: global_comm + integer :: maxthreads + integer :: dbrc + character(len=*), parameter :: subname = "(esm.F90:SetModelServices)" + !------------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + !------------------------------------------- + ! Set the io logunit to the value defined in ensemble_driver + ! it may be corrected below if the med mastertask is not the driver mastertask + !------------------------------------------- + call shr_file_setLogunit(logunit) + + !------------------------------------------- + ! Get the config and vm objects from the driver + !------------------------------------------- + + call ESMF_GridCompGet(driver, vm=vm, config=config, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=localPet, mpiCommunicator=global_comm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------------------------------- + ! determine the generic component labels + !------------------------------------------- + + componentCount = ESMF_ConfigGetLen(config,label="CESM_component_list:", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (componentCount == 0) then + write (msgstr, *) "No models were specified in CESM_component_list " + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + + !------------------------------------------- + ! Obtain driver attributes + !------------------------------------------- + + call ReadAttributes(driver, config, "DRIVER_attributes::", formatprint=.true., rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ReadAttributes(driver, config, "FLDS_attributes::", formatprint=.true., rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ReadAttributes(driver, config, "CLOCK_attributes::", formatprint=.true., rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ReadAttributes(driver, config, "ALLCOMP_attributes::", formatprint=.true., rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ReadAttributes(driver, config, "PELAYOUT_attributes::", formatprint=.true., rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call CheckAttributes(driver, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------------------------------- + ! Initialize other attributes (after initializing driver clock) + !------------------------------------------- + + call InitAttributes(driver, mastertask, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------------------------------- + ! Initialize component pe layouts + !------------------------------------------- + + call esm_init_pelayout(driver, maxthreads, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Print out present flags to mediator log file + if (mastertask) then + ! Memory test + call shr_mem_init(strbuf=meminitstr) + + write(logunit,*) trim(meminitstr) + write(logunit,*) trim(subname)//":atm_present="//trim(atm_present) + write(logunit,*) trim(subname)//":lnd_present="//trim(lnd_present) + write(logunit,*) trim(subname)//":ocn_present="//trim(ocn_present) + write(logunit,*) trim(subname)//":ice_present="//trim(ice_present) + write(logunit,*) trim(subname)//":rof_present="//trim(rof_present) + write(logunit,*) trim(subname)//":wav_present="//trim(wav_present) + write(logunit,*) trim(subname)//":glc_present="//trim(glc_present) + write(logunit,*) trim(subname)//":med_present="//trim(med_present) + end if + + !------------------------------------------- + ! Timer initialization (has to be after pelayouts are determined) + !------------------------------------------- + + call t_initf(nlfilename, LogPrint=.true., mpicom=global_comm, & + mastertask=mastertask, MaxThreads=maxthreads) + + !------------------------------------------- + ! Perform restarts if appropriate + !------------------------------------------- + + call InitRestart(driver, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine SetModelServices + + !================================================================================ + + subroutine SetRunSequence(driver, rc) + + use ESMF , only : ESMF_GridComp, ESMF_LogWrite, ESMF_SUCCESS, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_Time, ESMF_TimeInterval, ESMF_Config + use ESMF , only : ESMF_GridCompGet, ESMF_ConfigCreate + use ESMF , only : ESMF_ConfigLoadFile + use NUOPC , only : NUOPC_FreeFormat, NUOPC_FreeFormatDestroy + use NUOPC , only : NUOPC_FreeFormatCreate + use NUOPC_Driver , only : NUOPC_DriverIngestRunSequence, NUOPC_DriverSetRunSequence + use NUOPC_Driver , only : NUOPC_DriverPrint + + ! input/output variables + type(ESMF_GridComp) :: driver + integer, intent(out) :: rc + + ! local variables + integer :: localrc + type(ESMF_Config) :: runSeq + type(NUOPC_FreeFormat) :: runSeqFF + integer :: dbrc + character(len=*), parameter :: subname = "(esm.F90:SetRunSequence)" + !--------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + !-------- + ! Run Sequence and Connectors + !-------- + + ! read free format run sequence + + runSeq = ESMF_ConfigCreate(rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ConfigLoadFile(runSeq, "nuopc.runseq", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + runSeqFF = NUOPC_FreeFormatCreate(runSeq, label="runSeq::", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_DriverIngestRunSequence(driver, runSeqFF, autoAddConnectors=.true., rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Uncomment these to add debugging information for driver + ! call NUOPC_DriverPrint(driver, orderflag=.true.) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + ! line=__LINE__, & + ! file=__FILE__)) & + ! return ! bail out + + ! call pretty_print_nuopc_freeformat(runSeqFF, 'run sequence', rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_FreeFormatDestroy(runSeqFF, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine SetRunSequence + + !================================================================================ + + subroutine pretty_print_nuopc_freeformat(ffstuff, label, rc) + + use NUOPC, only : NUOPC_FreeFormat, NUOPC_FreeFormatGet, NUOPC_FreeFormatLen + use ESMF, only : ESMF_SUCCESS + + ! input/output variables + type(NUOPC_FreeFormat) , intent(in) :: ffstuff + character(len=*) :: label + integer , intent(out) :: rc + + ! local variables + integer :: i + integer :: linecnt + character(len=NUOPC_FreeFormatLen), pointer :: outstr(:) + !--------------------------------------- + + rc = ESMF_SUCCESS + + if (mastertask .or. dbug_flag > 3) then + write(logunit, *) 'BEGIN: ', trim(label) + call NUOPC_FreeFormatGet(ffstuff, linecount=linecnt, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(outstr(linecnt)) + call NUOPC_FreeFormatGet(ffstuff, stringList=outstr, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + do i=1,linecnt + if(len_trim(outstr(i)) > 0) then + write(logunit, *) trim(outstr(i)) + endif + enddo + write(logunit, *) 'END: ', trim(label) + deallocate(outstr) + endif + + end subroutine pretty_print_nuopc_freeformat + + !================================================================================ + + recursive subroutine ModifyCplLists(driver, importState, exportState, clock, rc) + + use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_LogWrite + use ESMF , only : ESMF_LOGMSG_INFO, ESMF_CplComp, ESMF_SUCCESS + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet + use NUOPC_Driver , only : NUOPC_DriverGetComp + + type(ESMF_GridComp) :: driver + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + type(ESMF_CplComp), pointer :: connectorList(:) + integer :: i, j, cplListSize + character(len=160), allocatable :: cplList(:) + character(len=160) :: tempString + integer :: dbrc + character(len=*), parameter :: subname = "(esm.F90:ModifyCplLists)" + !--------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + call ESMF_LogWrite("Driver is in ModifyCplLists()", ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + nullify(connectorList) + call NUOPC_DriverGetComp(driver, compList=connectorList, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgstr,*) "Found ", size(connectorList), " Connectors."// " Modifying CplList Attribute...." + call ESMF_LogWrite(trim(msgstr), ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + do i=1, size(connectorList) + + ! query the cplList for connector i + call NUOPC_CompAttributeGet(connectorList(i), name="CplList", itemCount=cplListSize, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (cplListSize>0) then + allocate(cplList(cplListSize)) + + call NUOPC_CompAttributeGet(connectorList(i), name="CplList", valueList=cplList, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! go through all of the entries in the cplList and set the mapping method to "redist" + do j=1, cplListSize + !tempString = trim(cplList(j))//":REMAPMETHOD=bilinear"//& + !":SrcTermProcessing=1:DUMPWEIGHTS=true:TermOrder=SrcSeq" + + tempString = trim(cplList(j))//":remapmethod=redist" + cplList(j) = trim(tempString) + enddo + + ! store the modified cplList in CplList attribute of connector i + call NUOPC_CompAttributeSet(connectorList(i), name="CplList", valueList=cplList, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + deallocate(cplList) + endif + enddo + + deallocate(connectorList) + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine ModifyCplLists + + !================================================================================ + + function IsRestart(gcomp, rc) + + use ESMF , only : ESMF_GridComp, ESMF_SUCCESS + use ESMF , only : ESMF_LogSetError, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_RC_NOT_VALID + use NUOPC , only : NUOPC_CompAttributeGet + + ! input/output variables + logical :: IsRestart + type(ESMF_GridComp) , intent(inout) :: gcomp + integer , intent(out) :: rc + + ! locals + character(len=*) , parameter :: start_type_start = "startup" + character(len=*) , parameter :: start_type_cont = "continue" + character(len=*) , parameter :: start_type_brnch = "branch" + character(SHR_KIND_CL) :: start_type ! Type of startup + character(len=*), parameter :: subname = "(esm.F90:IsRestart)" + !--------------------------------------- + + rc = ESMF_SUCCESS + + ! First Determine if restart is read + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=start_type, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if ((trim(start_type) /= start_type_start) .and. & + (trim(start_type) /= start_type_cont ) .and. & + (trim(start_type) /= start_type_brnch)) then + write (msgstr, *) subname//': start_type invalid = '//trim(start_type) + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return + end if + + !TODO: this is hard-wired to CIME start/continue types in terms of gcomp + IsRestart = .false. + if (trim(start_type) == trim(start_type_cont) .or. trim(start_type) == trim(start_type_brnch)) then + IsRestart = .true. + end if + + end function IsRestart + + !================================================================================ + + subroutine InitRestart(driver, rc) + + !----------------------------------------------------- + ! Determine if will restart and read pointer file if appropriate + !----------------------------------------------------- + + use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_GridCompGet, ESMF_VMGet, ESMF_SUCCESS + use ESMF , only : ESMF_LogSetError, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_RC_NOT_VALID + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd + use shr_sys_mod , only : shr_sys_abort + use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit + use shr_mpi_mod , only : shr_mpi_bcast + + ! input/output variables + type(ESMF_GridComp) , intent(inout) :: driver + integer , intent(out) :: rc + + ! local variables + character(SHR_KIND_CL) :: cvalue ! temporary + logical :: read_restart ! read the restart file, based on start_type + character(SHR_KIND_CL) :: rest_case_name ! Short case identification + character(len=*) , parameter :: subname = "(esm.F90:InitRestart)" + !------------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + endif + + !----------------------------------------------------- + ! Carry out restart if appropriate + !----------------------------------------------------- + + read_restart = IsRestart(driver, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Add rest_case_name and read_restart to driver attributes + call NUOPC_CompAttributeAdd(driver, attrList=(/'rest_case_name','read_restart'/), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + rest_case_name = ' ' + call NUOPC_CompAttributeSet(driver, name='rest_case_name', value=rest_case_name, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + write(cvalue,*) read_restart + call NUOPC_CompAttributeSet(driver, name='read_restart', value=trim(cvalue), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine InitRestart + + !================================================================================ + + subroutine InitAttributes(driver, mastertask, rc) + + use shr_sys_mod , only : shr_sys_abort + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_Time, ESMF_TimeGet + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LogSetError, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_RC_NOT_VALID + use ESMF , only : ESMF_GridCompIsPetLocal, ESMF_VMBroadcast + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd + use shr_orb_mod , only : shr_orb_params, SHR_ORB_UNDEF_INT, SHR_ORB_UNDEF_REAL + use shr_assert_mod , only : shr_assert_in_domain + use shr_cal_mod , only : shr_cal_date2ymd + use shr_const_mod , only : shr_const_tkfrz, shr_const_tktrip + use shr_const_mod , only : shr_const_mwwv, shr_const_mwdair + use shr_frz_mod , only : shr_frz_freezetemp_init + use shr_reprosum_mod , only : shr_reprosum_setopts + use shr_wv_sat_mod , only : shr_wv_sat_set_default, shr_wv_sat_init + use shr_wv_sat_mod , only : shr_wv_sat_make_tables, ShrWVSatTableSpec + use shr_wv_sat_mod , only : shr_wv_sat_get_scheme_idx, shr_wv_sat_valid_idx + !use shr_scam_mod , only : shr_scam_checkSurface + + ! input/output variables + type(ESMF_GridComp) , intent(inout) :: driver + logical , intent(in) :: mastertask ! mediator mastertask + integer , intent(out) :: rc ! return code + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currTime + character(SHR_KIND_CL) :: errstring + character(SHR_KIND_CL) :: cvalue + logical :: reprosum_use_ddpdd ! setup reprosum, use ddpdd + real(SHR_KIND_R8) :: reprosum_diffmax ! setup reprosum, set rel_diff_max + logical :: reprosum_recompute ! setup reprosum, recompute if tolerance exceeded + integer :: year ! Current date (YYYY) + character(SHR_KIND_CS) :: tfreeze_option ! Freezing point calculation + character(SHR_KIND_CL) :: orb_mode ! orbital mode + integer :: orb_iyear ! orbital year + integer :: orb_iyear_align ! associated with model year + integer :: orb_cyear ! orbital year for current orbital computation + integer :: orb_nyear ! orbital year associated with currrent model year + integer :: orbitmp(4) ! array for integer parameter broadcast + real(SHR_KIND_R8) :: orbrtmp(6) ! array for real parameter broadcast + real(SHR_KIND_R8) :: orb_eccen ! orbital eccentricity + real(SHR_KIND_R8) :: orb_obliq ! obliquity in degrees + real(SHR_KIND_R8) :: orb_mvelp ! moving vernal equinox long + real(SHR_KIND_R8) :: orb_obliqr ! Earths obliquity in rad + real(SHR_KIND_R8) :: orb_lambm0 ! Mean long of perihelion at vernal equinox (radians) + real(SHR_KIND_R8) :: orb_mvelpp ! moving vernal equinox long + real(SHR_KIND_R8) :: wall_time_limit ! wall time limit in hours + logical :: single_column ! scm mode logical + real(SHR_KIND_R8) :: scmlon ! single column lon + real(SHR_KIND_R8) :: scmlat ! single column lat + character(SHR_KIND_CS) :: wv_sat_scheme + real(SHR_KIND_R8) :: wv_sat_transition_start + logical :: wv_sat_use_tables + real(SHR_KIND_R8) :: wv_sat_table_spacing + type(ShrWVSatTableSpec) :: liquid_spec + type(ShrWVSatTableSpec) :: ice_spec + type(ShrWVSatTableSpec) :: mixed_spec + logical :: flag + integer :: i, it, n + integer :: unitn ! Namelist unit number to read + integer :: dbrc + integer :: localPet, rootpe_med + integer , parameter :: ens1=1 ! use first instance of ensemble only + integer , parameter :: fix1=1 ! temporary hard-coding to first ensemble, needs to be fixed + real(SHR_KIND_R8), parameter :: epsilo = shr_const_mwwv/shr_const_mwdair + 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 :: subname = '(InitAttributes)' + + !---------------------------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + call shr_nuopc_memcheck(subname, 0, mastertask) + + !---------------------------------------------------------- + ! Initialize options for reproducible sums + !---------------------------------------------------------- + + call NUOPC_CompAttributeGet(driver, name="reprosum_use_ddpdd", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) reprosum_use_ddpdd + + call NUOPC_CompAttributeGet(driver, name="reprosum_diffmax", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) reprosum_diffmax + + call NUOPC_CompAttributeGet(driver, name="reprosum_recompute", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) reprosum_recompute + + call shr_reprosum_setopts(repro_sum_use_ddpdd_in=reprosum_use_ddpdd, & + repro_sum_rel_diff_max_in=reprosum_diffmax, repro_sum_recompute_in=reprosum_recompute) + + !---------------------------------------------------------- + ! Initialize freezing point calculation for all components + !---------------------------------------------------------- + + call NUOPC_CompAttributeGet(driver, name="tfreeze_option", value=tfreeze_option, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_frz_freezetemp_init(tfreeze_option, mastertask) + + !---------------------------------------------------------- + ! Initialize orbital related values + !---------------------------------------------------------- + + call NUOPC_CompAttributeGet(driver, name="orb_mode", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_mode + + call NUOPC_CompAttributeGet(driver, name="orb_iyear", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_iyear + + call NUOPC_CompAttributeGet(driver, name="orb_iyear_align", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_iyear_align + + call NUOPC_CompAttributeGet(driver, name="orb_obliq", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_obliq + + call NUOPC_CompAttributeGet(driver, name="orb_eccen", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_eccen + + call NUOPC_CompAttributeGet(driver, name="orb_mvelp", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) orb_mvelp + + if (trim(orb_mode) == trim(orb_fixed_year)) then + orb_obliq = SHR_ORB_UNDEF_REAL + orb_eccen = SHR_ORB_UNDEF_REAL + orb_mvelp = SHR_ORB_UNDEF_REAL + if (orb_iyear == SHR_ORB_UNDEF_INT) then + write(logunit,*) trim(subname),' ERROR: invalid settings orb_mode =',trim(orb_mode) + write(logunit,*) trim(subname),' ERROR: fixed_year settings = ',orb_iyear + write (msgstr, *) ' ERROR: invalid settings for orb_mode '//trim(orb_mode) + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + elseif (trim(orb_mode) == trim(orb_variable_year)) then + orb_obliq = SHR_ORB_UNDEF_REAL + orb_eccen = SHR_ORB_UNDEF_REAL + orb_mvelp = SHR_ORB_UNDEF_REAL + if (orb_iyear == SHR_ORB_UNDEF_INT .or. orb_iyear_align == SHR_ORB_UNDEF_INT) then + write(logunit,*) trim(subname),' ERROR: invalid settings orb_mode =',trim(orb_mode) + write(logunit,*) trim(subname),' ERROR: variable_year settings = ',orb_iyear, orb_iyear_align + write (msgstr, *) subname//' ERROR: invalid settings for orb_mode '//trim(orb_mode) + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + elseif (trim(orb_mode) == trim(orb_fixed_parameters)) then + !-- force orb_iyear to undef to make sure shr_orb_params works properly + orb_iyear = SHR_ORB_UNDEF_INT + orb_iyear_align = SHR_ORB_UNDEF_INT + if (orb_eccen == SHR_ORB_UNDEF_REAL .or. & + orb_obliq == SHR_ORB_UNDEF_REAL .or. & + orb_mvelp == SHR_ORB_UNDEF_REAL) then + write(logunit,*) trim(subname),' ERROR: invalid settings orb_mode =',trim(orb_mode) + write(logunit,*) trim(subname),' ERROR: orb_eccen = ',orb_eccen + write(logunit,*) trim(subname),' ERROR: orb_obliq = ',orb_obliq + write(logunit,*) trim(subname),' ERROR: orb_mvelp = ',orb_mvelp + write (msgstr, *) subname//' ERROR: invalid settings for orb_mode '//trim(orb_mode) + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + else + write (msgstr, *) subname//' ERROR: invalid orb_mode '//trim(orb_mode) + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + + call NUOPC_CompAttributeGet(driver, name='cpl_rootpe', value=cvalue, rc=rc) + read(cvalue, *) rootpe_med + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_GridCompGet(driver, localPet=localPet, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine orbital params + if (trim(orb_mode) == trim(orb_variable_year)) then + call ESMF_GridCompGet(driver, clock=clock, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(CurrTime, yy=year, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + orb_cyear = orb_iyear + (year - orb_iyear_align) + call shr_orb_params(orb_cyear, orb_eccen, orb_obliq, orb_mvelp, & + orb_obliqr, orb_lambm0, orb_mvelpp, mastertask) + else + call shr_orb_params(orb_iyear, orb_eccen, orb_obliq, orb_mvelp, & + orb_obliqr, orb_lambm0, orb_mvelpp, mastertask) + end if + + if (orb_eccen == SHR_ORB_UNDEF_REAL .or. & + orb_obliqr == SHR_ORB_UNDEF_REAL .or. & + orb_mvelpp == SHR_ORB_UNDEF_REAL .or. & + orb_lambm0 == SHR_ORB_UNDEF_REAL) then + write (msgstr, *) subname//' ERROR: orb params incorrect' + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + + ! Add updated orbital params to driver attributes + + call NUOPC_CompAttributeAdd(driver, attrList=(/'orb_obliqr', 'orb_lambm0', 'orb_mvelpp'/), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + write(cvalue,*) orb_eccen + call NUOPC_CompAttributeSet(driver, name="orb_eccen", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + write(cvalue,*) orb_obliqr + call NUOPC_CompAttributeSet(driver, name="orb_obliqr", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + write(cvalue,*) orb_lambm0 + call NUOPC_CompAttributeSet(driver, name="orb_lambm0", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + write(cvalue,*) orb_mvelpp + call NUOPC_CompAttributeSet(driver, name="orb_mvelpp", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! TODO: need to update orbital parameters during run time - actually - each component needs to update its orbital + ! parameters to be consistent + + !---------------------------------------------------------- + ! Initialize water vapor info + !---------------------------------------------------------- + + ! TODO: this does not seem to belong here - where should it go? + + call NUOPC_CompAttributeGet(driver, name="wv_sat_scheme", value=wv_sat_scheme, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (.not. shr_wv_sat_valid_idx(shr_wv_sat_get_scheme_idx(trim(wv_sat_scheme)))) then + call shr_sys_abort(subname//': "'//trim(wv_sat_scheme)//'" is not a recognized saturation vapor pressure scheme name') + end if + if (.not. shr_wv_sat_set_default(wv_sat_scheme)) then + call shr_sys_abort('Invalid wv_sat_scheme.') + end if + + call NUOPC_CompAttributeGet(driver, name="wv_sat_transition_start", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) wv_sat_transition_start + + call shr_assert_in_domain(wv_sat_transition_start, & + ge=0._SHR_KIND_R8, le=40._SHR_KIND_R8, & + varname="wv_sat_transition_start", msg="Invalid transition temperature range.") + + call NUOPC_CompAttributeGet(driver, name="wv_sat_use_tables", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) wv_sat_use_tables + + call NUOPC_CompAttributeGet(driver, name="wv_sat_table_spacing", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) wv_sat_table_spacing + + ! A transition range averaging method in CAM is only valid for: + ! -40 deg C <= T <= 0 deg C + ! shr_wv_sat_mod itself checks for values with the wrong sign, but we + ! have to check that the range is no more than 40 deg C here. Even + ! though this is a CAM-specific restriction, it's not really likely + ! that any other parameterization will be dealing with mixed-phase + ! water below 40 deg C anyway. + + call shr_wv_sat_init(shr_const_tkfrz, shr_const_tktrip, wv_sat_transition_start, epsilo, errstring) + if (errstring /= "") then + call shr_sys_abort('shr_wv_sat_init: '//trim(errstring)) + end if + + ! The below produces internal lookup tables in the range 175-374K for + ! liquid water, and 125-274K for ice, with a resolution set by the + ! option wv_sat_table_spacing. + ! In theory these ranges could be specified in the namelist, but in + ! practice users will want to change them *very* rarely if ever, which + ! is why only the spacing is in the namelist. + + if (wv_sat_use_tables) then + liquid_spec = ShrWVSatTableSpec(ceiling(200._SHR_KIND_R8/wv_sat_table_spacing), 175._SHR_KIND_R8, wv_sat_table_spacing) + ice_spec = ShrWVSatTableSpec(ceiling(150._SHR_KIND_R8/wv_sat_table_spacing), 125._SHR_KIND_R8, wv_sat_table_spacing) + mixed_spec = ShrWVSatTableSpec(ceiling(250._SHR_KIND_R8/wv_sat_table_spacing), 125._SHR_KIND_R8, wv_sat_table_spacing) + call shr_wv_sat_make_tables(liquid_spec, ice_spec, mixed_spec) + end if + + !---------------------------------------------------------- + ! Set single_column flags + ! If in single column mode, overwrite flags according to focndomain file + ! in ocn_in namelist. SCAM can reset the "present" flags for lnd, + ! ocn, ice, rof, and flood. + !---------------------------------------------------------- + + call NUOPC_CompAttributeGet(driver, name="single_column", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) single_column + + ! NOTE: cam stand-alone aqua-planet model will no longer be supported here - only the data model aqua-planet + ! will be supported + if (single_column) then + + call NUOPC_CompAttributeGet(driver, name="scmlon", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scmlon + + call NUOPC_CompAttributeGet(driver, name="scmlat", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) scmlat + + ! TODO(mvertens, 2019-01-30): need to add single column functionality + + endif + + end subroutine InitAttributes + + !================================================================================ + + subroutine CheckAttributes( driver, rc ) + + ! !DESCRIPTION: Check that input driver config values have reasonable values + + use shr_sys_mod , only : shr_sys_abort + use ESMF , only : ESMF_GridComp, ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO + use NUOPC , only : NUOPC_CompAttributeGet + + ! !INPUT/OUTPUT PARAMETERS: + type(ESMF_GridComp) , intent(inout) :: driver + integer , intent(out) :: rc + + !----- local ----- + character(SHR_KIND_CL) :: cvalue ! temporary + character(SHR_KIND_CL) :: start_type ! Type of startup + character(SHR_KIND_CL) :: rest_case_name ! Short case identification + character(SHR_KIND_CS) :: logFilePostFix ! postfix for output log files + character(SHR_KIND_CL) :: outPathRoot ! root for output log files + character(SHR_KIND_CS) :: cime_model + integer :: dbrc + character(len=*), parameter :: subname = '(driver_attributes_check) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + call NUOPC_CompAttributeGet(driver, name="cime_model", value=cime_model, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if ( trim(cime_model) /= 'cesm') then + call shr_sys_abort( subname//': cime_model must be set to cesm, aborting') + end if + + ! --- LogFile ending name ----- + call NUOPC_CompAttributeGet(driver, name="logFilePostFix", value=logFilePostFix, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if ( len_trim(logFilePostFix) == 0 ) then + call shr_sys_abort( subname//': logFilePostFix must be set to something not blank' ) + end if + + ! --- Output path root directory ----- + call NUOPC_CompAttributeGet(driver, name="outPathRoot", value=outPathRoot, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if ( len_trim(outPathRoot) == 0 ) then + call shr_sys_abort( subname//': outPathRoot must be set' ) + end if + if ( index(outPathRoot, "/", back=.true.) /= len_trim(outPathRoot) ) then + call shr_sys_abort( subname//': outPathRoot must end with a slash' ) + end if + + ! --- Case name and restart case name ------ + ! call NUOPC_CompAttributeGet(driver, name="rest_case_name", value=rest_case_name, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! if ((trim(start_type) == start_type_cont ) .and. (trim(case_name) /= trim(rest_case_name))) then + ! write(logunit,'(10a)') subname,' case_name =',trim(case_name),':',' rest_case_name =',trim(rest_case_name),':' + ! call shr_sys_abort(subname//': invalid continue restart case name = '//trim(rest_case_name)) + ! endif + + end subroutine CheckAttributes + + !=============================================================================== + + subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, rc) + + ! Add specific set of attributes to components from driver attributes + + use ESMF , only : ESMF_GridComp, ESMF_Config, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_LogFoundAllocError, ESMF_ConfigGetLen, ESMF_ConfigGetAttribute + use NUOPC , only : NUOPC_CompAttributeAdd, NUOPC_CompAttributeGet, NUOPC_CompAttributeSet + + ! input/output parameters + type(ESMF_GridComp) , intent(inout) :: gcomp + type(ESMF_GridComp) , intent(in) :: driver + type(ESMF_Config) , intent(inout) :: config + integer , intent(in) :: compid + character(len=*) , intent(in) :: compname + character(len=*) , intent(in) :: inst_suffix + integer , intent(inout) :: rc + + ! local variables + integer :: n + integer :: stat + integer :: inst_index + character(len=SHR_KIND_CL) :: cvalue + character(len=32), allocatable :: compLabels(:) + character(len=32), allocatable :: attrList(:) + integer :: dbrc + character(len=*), parameter :: subname = "(esm.F90:AddAttributes)" + logical :: lvalue = .false. + !------------------------------------------- + + rc = ESMF_Success + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + !------ + ! Add compid to gcomp attributes + !------ + write(cvalue,*) compid + call NUOPC_CompAttributeAdd(gcomp, attrList=(/'MCTID'/), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name='MCTID', value=trim(cvalue), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------ + ! Add all the other attributes in AttrList (which have already been added to driver attributes) + !------ + allocate(attrList(5)) + attrList = (/"read_restart", "orb_eccen", "orb_obliqr", "orb_lambm0", "orb_mvelpp"/) + + call NUOPC_CompAttributeAdd(gcomp, attrList=attrList, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(attrList) + call NUOPC_CompAttributeGet(driver, name=trim(attrList(n)), value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name=trim(attrList(n)), value=trim(cvalue), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + enddo + deallocate(attrList) + + !------ + ! Add component specific attributes + !------ + call ReadAttributes(gcomp, config, trim(compname)//"_attributes::", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ReadAttributes(gcomp, config, "ALLCOMP_attributes::", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ReadAttributes(gcomp, config, trim(compname)//"_modelio"//trim(inst_suffix)//"::", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ReadAttributes(gcomp, config, "CLOCK_attributes::", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------ + ! Add mediator specific attributes + !------ + if (compname == 'MED') then + call ReadAttributes(gcomp, config, "MED_history_attributes::", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ReadAttributes(gcomp, config, "FLDS_attributes::", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + componentCount = ESMF_ConfigGetLen(config,label="CESM_component_list:", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + allocate(compLabels(componentCount), stat=stat) + if (ESMF_LogFoundAllocError(statusToCheck=stat, msg="Allocation of compLabels failed.", & + line=__LINE__, file=u_FILE_u, rcToReturn=rc)) return + + call ESMF_ConfigGetAttribute(config, valueList=compLabels, label="CESM_component_list:", & + count=componentCount, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeAdd(gcomp, & + attrList=(/'atm_present','lnd_present','ocn_present','ice_present',& + 'rof_present','wav_present','glc_present','med_present'/), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + med_present = "false" + atm_present = "false" + lnd_present = "false" + ocn_present = "false" + ice_present = "false" + rof_present = "false" + wav_present = "false" + glc_present = "false" + do n=1, componentCount + if (trim(compLabels(n)) == "MED") med_present = "true" + if (trim(compLabels(n)) == "ATM") atm_present = "true" + if (trim(compLabels(n)) == "LND") lnd_present = "true" + if (trim(compLabels(n)) == "OCN") ocn_present = "true" + if (trim(compLabels(n)) == "ICE") ice_present = "true" + if (trim(compLabels(n)) == "ROF") rof_present = "true" + if (trim(compLabels(n)) == "WAV") wav_present = "true" + if (trim(compLabels(n)) == "GLC") glc_present = "true" + enddo + + call NUOPC_CompAttributeSet(gcomp, name="atm_present", value=atm_present, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name="lnd_present", value=lnd_present, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name="ocn_present", value=ocn_present, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name="ice_present", value=ice_present, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name="rof_present", value=rof_present, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name="wav_present", value=wav_present, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name="glc_present", value=glc_present, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name="med_present", value=med_present, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(driver, name="mediator_read_restart", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + read(cvalue,*) lvalue + if (lvalue) then + call NUOPC_CompAttributeSet(gcomp, name="read_restart", value='.true.', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + endif + + !------ + ! Add multi-instance specific attributes + !------ + call NUOPC_CompAttributeAdd(gcomp, attrList=(/'inst_index'/), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! add inst_index attribute (inst_index is not required for cime internal components) + ! for now hard-wire inst_index to 1 + inst_index = 1 + write(cvalue,*) inst_index + call NUOPC_CompAttributeSet(gcomp, name='inst_index', value=trim(cvalue), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! add inst_suffix attribute + if (len_trim(inst_suffix) > 0) then + call NUOPC_CompAttributeAdd(gcomp, attrList=(/'inst_suffix'/), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name='inst_suffix', value=inst_suffix, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + end subroutine AddAttributes + + !================================================================================ + + subroutine ReadAttributes(gcomp, config, label, relaxedflag, formatprint, rc) + + use ESMF , only : ESMF_GridComp, ESMF_Config, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use NUOPC , only : NUOPC_FreeFormatCreate, NUOPC_CompAttributeIngest + use NUOPC , only : NUOPC_FreeFormatDestroy, NUOPC_FreeFormat + + ! input/output arguments + type(ESMF_GridComp) , intent(inout) :: gcomp + type(ESMF_Config) , intent(in) :: config + character(len=*) , intent(in) :: label + logical , intent(in), optional :: relaxedflag + logical , intent(in), optional :: formatprint + integer , intent(inout) :: rc + + ! local variables + type(NUOPC_FreeFormat) :: attrFF + integer :: dbrc + character(len=*), parameter :: subname = "(esm.F90:ReadAttributes)" + !------------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + if (present(relaxedflag)) then + attrFF = NUOPC_FreeFormatCreate(config, label=trim(label), relaxedflag=.true., rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else + attrFF = NUOPC_FreeFormatCreate(config, label=trim(label), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + call NUOPC_CompAttributeIngest(gcomp, attrFF, addFlag=.true., rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! if (present (formatprint)) then + ! call pretty_print_nuopc_freeformat(attrFF, trim(label)//' attributes', rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! end if + + call NUOPC_FreeFormatDestroy(attrFF, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine ReadAttributes + + !================================================================================ + + subroutine InitAdvertize(driver, importState, exportState, clock, rc) + + ! This empty InitAdvertise is needed because it overrides the behavior + ! of the default InitAdvertise inside the generic NUOPC_Driver.F90. The + ! default behavior tries to mirror the fields up the hierarchy (i.e., up + ! to the ensemble driver). This would be used if we needed to + ! communicate between the ensemble members. Since we do not need that + ! right now, we turn it off with this empty subroutine. + + use ESMF, only : ESMF_GridComp, ESMF_State, ESMF_Clock + use ESMF, only : ESMF_LogWrite, ESMF_SUCCESS, ESMF_LOGMSG_INFO + + ! input/output variables + type(ESMF_GridComp) :: driver + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + integer :: dbrc + character(len=*), parameter :: subname = "(esm.F90:InitAdvertize)" + !--------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine InitAdvertize + + !================================================================================ + + subroutine esm_init_pelayout(driver, maxthreads, rc) + + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_VM, ESMF_VMGet + use ESMF , only : ESMF_LogWrite, ESMF_SUCCESS, ESMF_LOGMSG_INFO, ESMF_Config + use ESMF , only : ESMF_ConfigGetLen, ESMF_LogFoundAllocError, ESMF_ConfigGetAttribute + use ESMF , only : ESMF_RC_NOT_VALID, ESMF_LogSetError + use ESMF , only : ESMF_GridCompIsPetLocal, ESMF_MethodAdd + use NUOPC , only : NUOPC_CompAttributeGet + use NUOPC_Driver , only : NUOPC_DriverAddComp + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_string_mod , only : toLower => shr_string_toLower + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag, CS, CL + use atm_comp_nuopc , only : ATMSetServices => SetServices + use ice_comp_nuopc , only : ICESetServices => SetServices + use lnd_comp_nuopc , only : LNDSetServices => SetServices + use ocn_comp_nuopc , only : OCNSetServices => SetServices + use wav_comp_nuopc , only : WAVSetServices => SetServices + use rof_comp_nuopc , only : ROFSetServices => SetServices + use glc_comp_nuopc , only : GLCSetServices => SetServices + use MED , only : MEDSetServices => SetServices + use mpi , only : MPI_COMM_NULL + use mct_mod , only : mct_world_init + use shr_pio_mod , only : shr_pio_init2 + + ! input/output variables + type(ESMF_GridComp) :: driver + integer, intent(out) :: maxthreads ! maximum number of threads any component + integer, intent(out) :: rc + + ! local variables + type(ESMF_GridComp) :: child + type(ESMF_VM) :: vm + type(ESMF_Config) :: config + integer :: componentcount + integer :: PetCount + integer :: LocalPet + integer :: ntasks, rootpe, nthrds, stride + integer :: ntask, cnt + integer :: i + integer :: stat + character(len=32), allocatable :: compLabels(:) + character(CS) :: namestr + character(CL) :: msgstr + integer, allocatable :: petlist(:) + integer, pointer :: comms(:), comps(:) + integer :: Global_Comm + logical :: isPresent + integer, allocatable :: comp_comm_iam(:) + logical, allocatable :: comp_iamin(:) + character(len=5) :: inst_suffix + character(CL) :: cvalue + character(len=*), parameter :: subname = "(esm_pelayout.F90:esm_init_pelayout)" + !--------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + maxthreads = 1 + call ESMF_GridCompGet(driver, vm=vm, config=config, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ReadAttributes(driver, config, "PELAYOUT_attributes::", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, petCount=petCount, mpiCommunicator=Global_Comm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + componentCount = ESMF_ConfigGetLen(config,label="CESM_component_list:", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + allocate(compLabels(componentCount), stat=stat) + if (ESMF_LogFoundAllocError(statusToCheck=stat, msg="Allocation of compLabels failed.", & + line=__LINE__, file=u_FILE_u, rcToReturn=rc)) return + allocate(comp_iamin(componentCount), stat=stat) + if (ESMF_LogFoundAllocError(statusToCheck=stat, msg="Allocation of compLabels failed.", & + line=__LINE__, file=u_FILE_u, rcToReturn=rc)) return + allocate(comp_comm_iam(componentCount), stat=stat) + if (ESMF_LogFoundAllocError(statusToCheck=stat, msg="Allocation of compLabels failed.", & + line=__LINE__, file=u_FILE_u, rcToReturn=rc)) return + + call ESMF_ConfigGetAttribute(config, valueList=compLabels, label="CESM_component_list:", count=componentCount, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(driver, name="inst_suffix", isPresent=isPresent, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + call NUOPC_CompAttributeGet(driver, name="inst_suffix", value=inst_suffix, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else + inst_suffix = "" + endif + + allocate(comms(componentCount+1), comps(componentCount+1)) + comps(1) = 1 + comms(1) = Global_Comm + do i=1,componentCount + + namestr = toLower(compLabels(i)) + if (namestr == 'med') namestr = 'cpl' + call NUOPC_CompAttributeGet(driver, name=trim(namestr)//'_ntasks', value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ntasks + + if (ntasks < 0 .or. ntasks > PetCount) then + write (msgstr, *) "Invalid NTASKS value specified for component: ",namestr, ' ntasks: ',ntasks + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + + call NUOPC_CompAttributeGet(driver, name=trim(namestr)//'_nthreads', value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) nthrds + + if(nthrds > maxthreads) maxthreads = nthrds + + call NUOPC_CompAttributeGet(driver, name=trim(namestr)//'_rootpe', value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) rootpe + if (rootpe < 0 .or. rootpe > PetCount) then + write (msgstr, *) "Invalid Rootpe value specified for component: ",namestr, ' rootpe: ',rootpe + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + if(rootpe+ntasks > PetCount) then + write (msgstr, *) "Invalid pelayout value specified for component: ",namestr, ' rootpe+ntasks: ',rootpe+ntasks + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + + call NUOPC_CompAttributeGet(driver, name=trim(namestr)//'_pestride', value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) stride + if (stride < 1 .or. rootpe+ntasks*stride > PetCount) then + write (msgstr, *) "Invalid pestride value specified for component: ",namestr, ' rootpe: ',rootpe, ' pestride: ', stride + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + + if (allocated(petlist) .and. size(petlist) .ne. ntasks) then + deallocate(petlist) + endif + if(.not. allocated(petlist)) then + allocate(petlist(ntasks)) + endif + + cnt = 1 + do ntask = rootpe, (rootpe+ntasks*stride)-1, stride + petlist(cnt) = ntask + cnt = cnt + 1 + enddo + + comps(i+1) = i+1 + + if (trim(compLabels(i)) .eq. 'MED') then + med_id = i + 1 + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), MEDSetServices, petList=petlist, comp=child, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + elseif(trim(compLabels(i)) .eq. 'ATM') then + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ATMSetServices, petList=petlist, comp=child, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + elseif(trim(compLabels(i)) .eq. 'LND') then + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), LNDSetServices, PetList=petlist, comp=child, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + elseif(trim(compLabels(i)) .eq. 'OCN') then + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), OCNSetServices, PetList=petlist, comp=child, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + elseif(trim(compLabels(i)) .eq. 'ICE') then + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ICESetServices, PetList=petlist, comp=child, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + elseif(trim(compLabels(i)) .eq. 'GLC') then + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), GLCSetServices, PetList=petlist, comp=child, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + elseif(trim(compLabels(i)) .eq. 'ROF') then + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ROFSetServices, PetList=petlist, comp=child, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + elseif(trim(compLabels(i)) .eq. 'WAV') then + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), WAVSetServices, PetList=petlist, comp=child, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + elseif(trim(compLabels(i)) .eq. 'ESP') then + !call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ESPSetServices, PetList=petlist, comp=child, rc=rc) + !if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + call AddAttributes(child, driver, config, i+1, trim(compLabels(i)), inst_suffix, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (ESMF_GridCompIsPetLocal(child, rc=rc)) then + call ESMF_GridCompGet(child, vm=vm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, mpiCommunicator=comms(i+1), localPet=comp_comm_iam(i), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call AddAttributes(child, driver, config, i+1, trim(compLabels(i)), inst_suffix, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! This code is not supported, we need an optional arg to NUOPC_DriverAddComp to include the + ! per component thread count. #3614572 in esmf_support + ! call ESMF_GridCompSetVMMaxPEs(child, maxPeCountPerPet=nthrds, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Attach methods for handling reading/writing of restart pointer file + call ESMF_MethodAdd(child, label="GetRestartFileToWrite", & + userRoutine=GetRestartFileToWrite, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MethodAdd(child, label="GetRestartFileToRead", & + userRoutine=GetRestartFileToRead, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + comp_iamin(i) = .true. + else + comms(i+1) = MPI_COMM_NULL + comp_iamin(i) = .false. + endif + enddo + + ! Initialize MCT (this is needed for data models and cice prescribed capability) + call mct_world_init(componentCount+1, GLOBAL_COMM, comms, comps) + + ! Initialize PIO + call shr_pio_init2(comps(2:), compLabels, comp_iamin, comms(2:), comp_comm_iam) + + deallocate(petlist, comms, comps, comp_iamin, comp_comm_iam) + + end subroutine esm_init_pelayout + + !================================================================================ + + subroutine esm_finalize(driver, rc) + + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_VM, ESMF_VMGet + use ESMF , only : ESMF_SUCCESS + use NUOPC , only : NUOPC_CompAttributeGet + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use perf_mod , only : t_prf, t_finalizef + use med_constants_mod , only : CL + + ! input/output variables + type(ESMF_GridComp) :: driver + integer, intent(out) :: rc + + ! local variables + character(CL) :: timing_dir ! timing directory + character(len=5) :: inst_suffix + logical :: isPresent + type(ESMF_VM) :: vm + integer :: mpicomm + !--------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_GridCompGet(driver, vm=vm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, mpiCommunicator=mpicomm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(driver, name="timing_dir",value=timing_dir, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(driver, name="inst_suffix", isPresent=isPresent, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + call NUOPC_CompAttributeGet(driver, name="inst_suffix", value=inst_suffix, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else + inst_suffix = "" + endif + call t_prf(trim(timing_dir)//'/model_timing'//trim(inst_suffix), & + mpicom=mpicomm) + + call t_finalizef() + + end subroutine esm_finalize + + !================================================================================ + + subroutine GetRestartFileToWrite(gcomp, rc) + + ! Method to be attached to components to handle + ! CESM specific ways of writing restart files + ! This is used with MOM6 now and may need to be + ! extended or generalized to other components + + use ESMF, only: ESMF_GridComp, ESMF_GridCompGet + use ESMF, only: ESMF_LogSetError, ESMF_SUCCESS, ESMF_RC_FILE_OPEN + use ESMF, only: ESMF_RC_ATTR_NOTSET + use ESMF, only: ESMF_Time, ESMF_TimeGet + use ESMF, only: ESMF_Clock, ESMF_ClockGetNextTime + use ESMF, only: ESMF_VM, ESMF_VMGet + use ESMF, only: ESMF_MAXSTR, ESMF_LogWrite, ESMF_LOGMSG_INFO + use NUOPC, only: NUOPC_CompAttributeGet, NUOPC_CompAttributeSet + use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer , intent(out) :: rc + + ! local variables + type(ESMF_VM) :: vm + integer :: localPet, nu, iostat + type(ESMF_Clock) :: clock + type(ESMF_Time) :: nextTime + character(ESMF_MAXSTR) :: casename, restartname + logical :: isPresent, isSet + integer :: year, month, day, seconds + character(len=*), parameter :: subname='GetRestartFileToWrite' + !--------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_SUCCESS + + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=casename, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (.not. isPresent .or. .not. isSet) then + call ESMF_LogSetError(ESMF_RC_ATTR_NOTSET, & + msg=subname//": case_name attribute must be set to generate restart filename", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return + endif + + call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Need to use next time step since clock is + ! not advanced until the end of the time interval + call ESMF_ClockGetNextTime(clock, nextTime, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(nextTime, yy=year, mm=month, dd=day, s=seconds, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I5.5)') & + trim(casename), year, month, day, seconds + + call NUOPC_CompAttributeSet(gcomp, name="RestartFileToWrite", & + value=trim(restartname), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=localPet, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (localPet == 0) then + ! Write name of restart file in the rpointer file + ! This is currently hard-coded for the ocean + nu = shr_file_getUnit() + open(nu, file='rpointer.ocn', form='formatted', & + status='unknown', iostat=iostat) + if (iostat /= 0) then + call ESMF_LogSetError(ESMF_RC_FILE_OPEN, & + msg=subname//' ERROR opening rpointer.ocn', & + line=__LINE__, file=u_FILE_u, rcToReturn=rc) + return + endif + write(nu,'(a)') trim(restartname)//'.nc' + close(nu) + call shr_file_freeUnit(nu) + endif + call ESMF_LogWrite(trim(subname)//": returning", ESMF_LOGMSG_INFO, rc=rc) + + end subroutine GetRestartFileToWrite + + !================================================================================ + + subroutine GetRestartFileToRead(gcomp, rc) + + use ESMF, only: ESMF_GridComp, ESMF_GridCompGet + use ESMF, only: ESMF_LogSetError, ESMF_SUCCESS, ESMF_RC_FILE_OPEN + use ESMF, only: ESMF_RC_FILE_READ + use ESMF, only: ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast + use ESMF, only: ESMF_MAXSTR, ESMF_LogWrite, ESMF_LOGMSG_INFO + use NUOPC, only: NUOPC_CompAttributeSet + use shr_file_mod, only: shr_file_getUnit, shr_file_freeUnit + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_VM) :: vm + integer :: localPet, readunit, iostat + logical :: is_restart + character(ESMF_MAXSTR) :: restartname + character(len=*), parameter :: subname='GetRestartFileToRead' + !--------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + endif + + is_restart = IsRestart(gcomp, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (is_restart) then + restartname = "" + + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=localPet, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (localPet == 0) then + readunit = shr_file_getUnit() + ! this hard coded for rpointer.ocn right now + open(readunit, file='rpointer.ocn', form='formatted', status='old', iostat=iostat) + if (iostat /= 0) then + call ESMF_LogSetError(ESMF_RC_FILE_OPEN, msg=subname//' ERROR opening rpointer.ocn', & + line=__LINE__, file=u_FILE_u, rcToReturn=rc) + return + endif + read(readunit,'(a)', iostat=iostat) restartname + if (iostat /= 0) then + call ESMF_LogSetError(ESMF_RC_FILE_READ, msg=subname//' ERROR reading rpointer.ocn', & + line=__LINE__, file=u_FILE_u, rcToReturn=rc) + return + endif + close(readunit) + endif + + ! broadcast attribute set on master task to all tasks + call ESMF_VMBroadcast(vm, restartname, count=ESMF_MAXSTR-1, rootPet=0, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + !write(logunit,*) trim(subname)//":restartfile after broadcast = "//trim(restartfile) + + call NUOPC_CompAttributeSet(gcomp, name='RestartFileToRead', & + value=trim(restartname), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + call ESMF_LogWrite(trim(subname)//": returning", ESMF_LOGMSG_INFO, rc=rc) + + end subroutine GetRestartFileToRead + +end module ESM diff --git a/src/drivers/cime/esmApp.F90 b/src/drivers/cime/esmApp.F90 new file mode 100644 index 00000000..d1b42c0a --- /dev/null +++ b/src/drivers/cime/esmApp.F90 @@ -0,0 +1,153 @@ +program esmApp + + !----------------------------------------------------------------------------- + ! Generic ESM application driver + !----------------------------------------------------------------------------- + + use ESMF, only : ESMF_Initialize, ESMF_CALKIND_GREGORIAN, ESMF_LOGKIND_MULTI + use ESMF, only : ESMF_END_ABORT, ESMF_LogFoundError, ESMF_Finalize, ESMF_LOGERR_PASSTHRU + use ESMF, only : ESMF_GridCompSetServices, ESMF_GridCompFinalize, ESMF_LogSet, ESMF_LogWrite + use ESMF, only : ESMF_GridCompDestroy, ESMF_LOGMSG_INFO, ESMF_GridComp, ESMF_GridCompRun + use ESMF, only : ESMF_GridCompFinalize, ESMF_GridCompCreate, ESMF_GridCompInitialize + use ESMF, only : ESMF_LOGKIND_MULTI_ON_ERROR + use mpi, only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE + use NUOPC, only : NUOPC_FieldDictionarySetup + use ensemble_driver, only : SetServices + use shr_pio_mod, only : shr_pio_init1, shr_pio_init2 + implicit none + integer :: COMP_COMM + integer :: rc, urc + type(ESMF_GridComp) :: ensemble_driver_comp + + call MPI_init(rc) + COMP_COMM = MPI_COMM_WORLD + ! For planned future use of async io using pio2. The IO tasks are seperated from the compute tasks here + ! and COMP_COMM will be MPI_COMM_NULL on the IO tasks which then call shr_pio_init2 and do not return until + ! the model completes. All other tasks call ESMF_Initialize. 8 is the maximum number of component models + ! supported + call shr_pio_init1(8, "drv_in", COMP_COMM) + if(COMP_COMM .eq. MPI_COMM_NULL) then +! call shr_pio_init2( + call mpi_finalize(ierror=rc) + stop + endif + !----------------------------------------------------------------------------- + ! Initialize ESMF + !----------------------------------------------------------------------------- +#define DEBUG +#ifdef DEBUG + call ESMF_Initialize(mpiCommunicator=COMP_COMM, logkindflag=ESMF_LOGKIND_MULTI, logappendflag=.false., & + defaultCalkind=ESMF_CALKIND_GREGORIAN, ioUnitLBound=5001, ioUnitUBound=5101, rc=rc) +#else + call ESMF_Initialize(mpiCommunicator=COMP_COMM, logkindflag=ESMF_LOGKIND_MULTI_ON_ERROR, logappendflag=.false., & + defaultCalkind=ESMF_CALKIND_GREGORIAN, ioUnitLBound=5001, ioUnitUBound=5101, rc=rc) +#endif + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_LogSet(flush=.true.) + + call ESMF_LogWrite("esmApp STARTING", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + !----------------------------------------------------------------------------- + ! Operate on the NUOPC Field dictionary + !----------------------------------------------------------------------------- + + call NUOPC_FieldDictionarySetup("fd.yaml", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + !----------------------------------------------------------------------------- + ! Create the earth system ensemble driver Component + !----------------------------------------------------------------------------- + + ensemble_driver_comp = ESMF_GridCompCreate(name="ensemble", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + !----------------------------------------------------------------------------- + ! SetServices for the ensemble driver Component + !----------------------------------------------------------------------------- + call ESMF_GridCompSetServices(ensemble_driver_comp, SetServices, userRc=urc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + !----------------------------------------------------------------------------- + ! Call Initialize for the earth system ensemble Component + !----------------------------------------------------------------------------- + + call ESMF_GridCompInitialize(ensemble_driver_comp, userRc=urc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + !----------------------------------------------------------------------------- + ! Call Run for the ensemble driver + !----------------------------------------------------------------------------- + call ESMF_GridCompRun(ensemble_driver_comp, userRc=urc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + !----------------------------------------------------------------------------- + ! Call Finalize for the ensemble driver + ! Destroy the ensemble driver + !----------------------------------------------------------------------------- + call ESMF_GridCompFinalize(ensemble_driver_comp, userRc=urc, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + + call ESMF_LogWrite("ESMF_GridCompDestroy called", ESMF_LOGMSG_INFO, rc=rc) +! call ESMF_LogSet(flush=.true., trace=.true., rc=rc) + call ESMF_GridCompDestroy(ensemble_driver_comp, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + call ESMF_LogWrite("ESMF_GridCompDestroy finished", ESMF_LOGMSG_INFO, rc=rc) + + !----------------------------------------------------------------------------- + ! Finalize ESMF + !----------------------------------------------------------------------------- + + call ESMF_LogWrite("esmApp FINISHED", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + call ESMF_Finalize(endflag=ESMF_END_ABORT) + ! Finalize ESMF + call ESMF_Finalize() + +end program diff --git a/src/drivers/cime/t_driver_timers_mod.F90 b/src/drivers/cime/t_driver_timers_mod.F90 new file mode 100644 index 00000000..fd316e6d --- /dev/null +++ b/src/drivers/cime/t_driver_timers_mod.F90 @@ -0,0 +1,117 @@ +module t_drv_timers_mod + + implicit none + public :: t_drvstopf, t_drvstartf + integer, private :: cpl_run_hash=0, cpl_comm_hash=0, cpl_budget_hash=0 + character(len=*),parameter :: strcpl = 'CPL:RUN' + character(len=*),parameter :: strcom = 'CPL:COMM' + character(len=*),parameter :: strbud = 'CPL:BUDGET' + +contains + + !=============================================================================== + + subroutine t_drvstartf(string,cplrun,cplcom,budget,barrier, hashint) + use perf_mod, only : t_barrierf, t_startf, t_adj_detailf + implicit none + + character(len=*),intent(in) :: string + logical,intent(in),optional :: cplrun + logical,intent(in),optional :: cplcom + logical,intent(in),optional :: budget + integer,intent(in),optional :: barrier + integer,intent(inout), optional :: hashint + + character(len=128) :: strbar + + logical :: lcplrun,lcplcom,lbudget + !------------------------------------------------------------------------------- + + lcplrun = .false. + lcplcom = .false. + lbudget = .false. + if (present(cplrun)) then + lcplrun = cplrun + endif + if (present(cplcom)) then + lcplcom = cplcom + endif + if (present(budget)) then + lbudget = budget + endif + + if (present(barrier)) then + strbar = trim(string)//'_BARRIER' + call t_barrierf (trim(strbar), barrier) + endif + + if (lcplrun) then + call t_startf (trim(strcpl), cpl_run_hash) + call t_adj_detailf(+1) + endif + + if (lcplcom) then + call t_startf (trim(strcom), cpl_comm_hash) + call t_adj_detailf(+1) + endif + + if (lbudget) then + call t_startf (trim(strbud), cpl_budget_hash) + call t_adj_detailf(+1) + endif + + call t_startf (trim(string),hashint) + call t_adj_detailf(+1) + + end subroutine t_drvstartf + + !=============================================================================== + + subroutine t_drvstopf(string,cplrun,cplcom,budget,hashint) + use perf_mod, only : t_stopf, t_adj_detailf + implicit none + + character(len=*),intent(in) :: string + logical,intent(in),optional :: cplrun + logical,intent(in),optional :: cplcom + logical,intent(in),optional :: budget + integer, intent(in), optional :: hashint + character(len=128) :: strbar + logical :: lcplrun,lcplcom,lbudget + + !------------------------------------------------------------------------------- + + lcplrun = .false. + lcplcom = .false. + lbudget = .false. + if (present(cplrun)) then + lcplrun = cplrun + endif + if (present(cplcom)) then + lcplcom = cplcom + endif + if (present(budget)) then + lbudget = budget + endif + + call t_adj_detailf(-1) + call t_stopf (trim(string), hashint) + + if (lbudget) then + call t_adj_detailf(-1) + call t_stopf (trim(strbud), cpl_budget_hash) + endif + + if (lcplrun) then + call t_adj_detailf(-1) + call t_stopf (trim(strcpl), cpl_run_hash) + endif + + if (lcplcom) then + call t_adj_detailf(-1) + call t_stopf (trim(strcom),cpl_comm_hash) + endif + + end subroutine t_drvstopf + +end module t_drv_timers_mod diff --git a/src/drivers/cime/util.F90 b/src/drivers/cime/util.F90 new file mode 100644 index 00000000..d8e97316 --- /dev/null +++ b/src/drivers/cime/util.F90 @@ -0,0 +1,79 @@ +module util + + !----------------------------------------------------------------------------- + ! CustomFieldDictionaryProto utility module + !----------------------------------------------------------------------------- + + use ESMF + use NUOPC + + implicit none + + private + + public FieldDictionaryLog + + !----------------------------------------------------------------------------- + contains + !----------------------------------------------------------------------------- + + subroutine FieldDictionaryLog(label, iofmt, rc) + + character(len=*), intent(in) :: label + type(ESMF_IOFmt_Flag), intent(in), optional :: iofmt + integer, intent(out), optional :: rc + + integer :: ibeg, iend, length + character(len=ESMF_MAXSTR) :: sep, title + type(NUOPC_FreeFormat) :: freeFormat + + if (present(rc)) rc = ESMF_SUCCESS + + write(sep,'(64("="))') + + ! build section separator with title + title = "> Begin Field Dictionary: " // trim(label) // " <" + length = len_trim(title) + + ! center title within separator + ibeg = max((64 - length)/2,1) + iend = min(ibeg+length-1,ESMF_MAXSTR) + sep(ibeg:iend) = title(1:iend-ibeg+1) + + call ESMF_LogWrite(sep, ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call NUOPC_FieldDictionaryEgest(freeFormat, iofmt=iofmt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call NUOPC_FreeFormatLog(freeFormat, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! build section separator with title + title = "> End Field Dictionary: " // trim(label) // " <" + length = len_trim(title) + + ! align with opening title + sep = "" + write(sep,'(64("="))') + iend = min(ibeg+length-1,ESMF_MAXSTR) + sep(ibeg:iend) = title(1:iend-ibeg+1) + + call ESMF_LogWrite(sep, ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end subroutine FieldDictionaryLog + +end module diff --git a/src/exch_flds/esmFlds.F90 b/src/exch_flds/esmFlds.F90 new file mode 100644 index 00000000..3fd26000 --- /dev/null +++ b/src/exch_flds/esmFlds.F90 @@ -0,0 +1,958 @@ +module esmflds + + use shr_kind_mod , only : CX => shr_kind_CX, CS=>shr_kind_CS, CL=>shr_kind_cl + use shr_sys_mod , only : shr_sys_abort + + implicit none + private + + !----------------------------------------------- + ! Set components + !----------------------------------------------- + + integer, public, parameter :: ncomps = 8 + integer, public, parameter :: compmed = 1 + integer, public, parameter :: compatm = 2 + integer, public, parameter :: complnd = 3 + integer, public, parameter :: compocn = 4 + integer, public, parameter :: compice = 5 + integer, public, parameter :: comprof = 6 + integer, public, parameter :: compwav = 7 + integer, public, parameter :: compglc = 8 + + character(len=*), public, parameter :: compname(ncomps) = & + (/'med','atm','lnd','ocn','ice','rof','wav','glc'/) + + !----------------------------------------------- + ! Set mappers + !----------------------------------------------- + + integer , public, parameter :: mapunset = 0 + integer , public, parameter :: mapbilnr = 1 + integer , public, parameter :: mapconsf = 2 + integer , public, parameter :: mapconsd = 3 + integer , public, parameter :: mappatch = 4 + integer , public, parameter :: mapfcopy = 5 + integer , public, parameter :: mapfiler = 6 + integer , public, parameter :: mapnstod = 7 ! nearest source to destination + integer , public, parameter :: mapnstod_consd = 8 ! nearest source to destination followed by conservative dst + integer , public, parameter :: mapnstod_consf = 9 ! nearest source to destination followed by conservative frac + integer , public, parameter :: nmappers = 9 + + character(len=*) , public, parameter :: mapnames(nmappers) = & + (/'bilnr', 'consf', 'consd', 'patch', 'fcopy', 'filer', 'nstod', 'nstod_consd', 'nstod_consf'/) + + !----------------------------------------------- + ! Set coupling mode + !----------------------------------------------- + + character(len=10), public :: coupling_mode ! valid values are [cesm,nems_orig,nems_frac] + + !----------------------------------------------- + ! PUblic methods + !----------------------------------------------- + + public :: shr_nuopc_fldList_AddFld + public :: shr_nuopc_fldList_AddMap + public :: shr_nuopc_fldList_AddMrg + public :: shr_nuopc_fldList_AddMetadata + public :: shr_nuopc_fldList_GetMetadata + public :: shr_nuopc_fldList_GetFldNames + public :: shr_nuopc_fldList_GetNumFlds + public :: shr_nuopc_fldList_GetFldInfo + public :: shr_nuopc_fldList_Realize + public :: shr_nuopc_fldList_Document_Mapping + public :: shr_nuopc_fldList_Document_Merging + + !----------------------------------------------- + ! Metadata array + !----------------------------------------------- + + integer, public , parameter :: CSS = 256 ! use longer short character + character(len=*), parameter :: undef = 'undefined' + integer , parameter :: nmax = 1000 ! maximum number of entries in metadta_entry + integer :: n_entries = 0 ! actual number of entries in metadta_entry + character(len=CSS) :: shr_nuopc_fldList_Metadata(nmax,4) = undef + + !----------------------------------------------- + ! Types and instantiations that determine fields, mappings, mergings + !----------------------------------------------- + + type, public :: shr_nuopc_fldList_entry_type + character(CS) :: stdname + character(CS) :: shortname + + ! Mapping fldsFr data - for mediator import fields + integer :: mapindex(ncomps) = mapunset + character(CS) :: mapnorm(ncomps) = 'unset' + character(CX) :: mapfile(ncomps) = 'unset' + + ! Merging fldsTo data - for mediator export fields + character(CS) :: merge_fields(ncomps) = 'unset' + character(CS) :: merge_types(ncomps) = 'unset' + character(CS) :: merge_fracnames(ncomps) = 'unset' + end type shr_nuopc_fldList_entry_type + + ! The above would be the field name to merge from + ! e.g. for Sa_z in lnd + ! merge_field(compatm) = 'Sa_z' + ! merge_type(comptm) = 'copy' (could also have 'copy_with_weighting') + + type, public :: shr_nuopc_fldList_type + type (shr_nuopc_fldList_entry_type), pointer :: flds(:) + end type shr_nuopc_fldList_type + + interface shr_nuopc_fldList_GetFldInfo ; module procedure & + shr_nuopc_fldList_GetFldInfo_general, & + shr_nuopc_fldList_GetFldInfo_stdname, & + shr_nuopc_fldList_GetFldInfo_merging + end interface + + !----------------------------------------------- + ! Instantiate derived types + !----------------------------------------------- + type (shr_nuopc_fldList_type), public :: fldListTo(ncomps) ! advertise fields to components + type (shr_nuopc_fldList_type), public :: fldListFr(ncomps) ! advertise fields from components + + type (shr_nuopc_fldList_type), public :: fldListMed_aoflux + type (shr_nuopc_fldList_type), public :: fldListMed_ocnalb + + integer :: dbrc + character(len=CL) :: infostr + character(len=*),parameter :: u_FILE_u = & + __FILE__ + +!================================================================================ +contains +!================================================================================ + + subroutine shr_nuopc_fldList_AddMetadata(fldname , longname, stdname, units) + + use NUOPC , only : NUOPC_FieldDictionaryAddEntry, NUOPC_FieldDictionaryHasEntry + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU + use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE + + ! input/output parameters: + character(len=*), intent(in) :: fldname + character(len=*), intent(in) :: longname + character(len=*), intent(in) :: stdname + character(len=*), intent(in) :: units + + ! local variables + integer :: n + logical :: found,FDfound + integer :: rc + character(len=*),parameter :: subname = '(shr_nuopc_fldList_AddMetadata) ' + !------------------------------------------------------------------------------- + + FDfound = .true. + if (.not.NUOPC_FieldDictionaryHasEntry(fldname)) then + FDfound = .false. + call ESMF_LogWrite(subname//': Add:'//trim(fldname), ESMF_LOGMSG_INFO, rc=dbrc) + call NUOPC_FieldDictionaryAddEntry(standardName=fldname, canonicalUnits=units, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + endif + + found = .false. + ! only do the search if it was already in the FD. If it wasn't, + ! then assume it's also not in the metadata table. + if (FDfound) then + n = 1 + do while (n <= n_entries .and. .not.found) + if (fldname == shr_nuopc_fldList_Metadata(n,1)) found=.true. + n = n + 1 + enddo + endif + + if (.not. found) then + n_entries = n_entries + 1 + if (n_entries > nmax) then + write(infostr,*) subname,' ERROR: n_entries= ',n_entries,' nmax = ',nmax,' fldname= ',trim(fldname) + call ESMF_LogWrite(trim(infostr),ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + write(infostr,*) subname,' ERROR: n_entries gt nmax' + call ESMF_LogWrite(trim(infostr),ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + end if + shr_nuopc_fldList_Metadata(n_entries,1) = trim(fldname) + shr_nuopc_fldList_Metadata(n_entries,2) = trim(longname) + shr_nuopc_fldList_Metadata(n_entries,3) = trim(stdname ) + shr_nuopc_fldList_Metadata(n_entries,4) = trim(units ) + endif + + end subroutine shr_nuopc_fldList_AddMetadata + + !=============================================================================== + + subroutine shr_nuopc_fldList_GetMetadata(shortname, longname, stdname, units) + + use shr_string_mod , only : shr_string_lastindex + + ! input/output variables + character(len=*), intent(in) :: shortname + character(len=*), optional, intent(out) :: longname + character(len=*), optional, intent(out) :: stdname + character(len=*), optional, intent(out) :: units + + ! local variables + integer :: i,n + character(len=CSS) :: llongname, lstdname, lunits, lshortname ! local copies + character(len=*),parameter :: unknown = 'unknown' + logical :: found + character(len=*),parameter :: subname = '(shr_nuopc_fldList_GetMetadata) ' + ! ---------------------------------------------- + + !--- define field metadata (name, long_name, standard_name, units) --- + + llongname = trim(unknown) + lstdname = trim(unknown) + lunits = trim(unknown) + + found = .false. + + if (.not.found) then + i = 1 + do while (i <= n_entries .and. .not.found) + lshortname = trim(shortname) + if (trim(lshortname) == trim(shr_nuopc_fldList_Metadata(i,1))) then + llongname = trim(shr_nuopc_fldList_Metadata(i,2)) + lstdname = trim(shr_nuopc_fldList_Metadata(i,3)) + lunits = trim(shr_nuopc_fldList_Metadata(i,4)) + found =.true. + end if + i = i + 1 + end do + endif + + if (.not.found) then + i = 1 + do while (i <= n_entries .and. .not.found) + n = shr_string_lastIndex(shortname,"_") + lshortname = "" + if (n < len_trim(shortname)) lshortname = shortname(n+1:len_trim(shortname)) + if (trim(lshortname) == trim(shr_nuopc_fldList_Metadata(i,1))) then + llongname = trim(shr_nuopc_fldList_Metadata(i,2)) + lstdname = trim(shr_nuopc_fldList_Metadata(i,3)) + lunits = trim(shr_nuopc_fldList_Metadata(i,4)) + found = .true. + end if + i = i + 1 + end do + endif + + if (present(longname)) then + longname = trim(llongname) + endif + if (present(stdname)) then + stdname = trim(lstdname) + endif + if (present(units)) then + units = trim(lunits) + endif + + end subroutine shr_nuopc_fldList_GetMetadata + + !================================================================================ + + subroutine shr_nuopc_fldList_AddFld(flds, stdname, shortname) + + ! ---------------------------------------------- + ! Add an entry to to the flds array + ! Use pointers to create an extensible allocatable array. + ! to allow the size of flds to grow, the process for + ! adding a new field is: + ! 1) allocate newflds to be N (one element larger than flds) + ! 2) copy flds into first N-1 elements of newflds + ! 3) newest flds entry is Nth element of newflds + ! 4) deallocate / nullify flds + ! 5) point flds => newflds + ! ---------------------------------------------- + + type(shr_nuopc_fldList_entry_type) , pointer :: flds(:) + character(len=*) , intent(in) :: stdname + character(len=*) , intent(in) , optional :: shortname + + ! local variables + integer :: n,oldsize,id + logical :: found + type(shr_nuopc_fldList_entry_type), pointer :: newflds(:) + character(len=*), parameter :: subname='(shr_nuopc_fldList_AddFld)' + ! ---------------------------------------------- + + if (associated(flds)) then + oldsize = size(flds) + found = .false. + do n= 1,oldsize + if (trim(stdname) == trim(flds(n)%stdname)) then + found = .true. + exit + end if + end do + else + oldsize = 0 + found = .false. + end if + id = oldsize + 1 + + ! create new entry if fldname is not in original list + + if (.not. found) then + + ! 1) allocate newfld to be size (one element larger than input flds) + allocate(newflds(id)) + + ! 2) copy flds into first N-1 elements of newflds + do n = 1,oldsize + newflds(n)%stdname = flds(n)%stdname + newflds(n)%shortname = flds(n)%shortname + newflds(n)%mapindex(:) = flds(n)%mapindex(:) + newflds(n)%mapnorm(:) = flds(n)%mapnorm(:) + newflds(n)%mapfile(:) = flds(n)%mapfile(:) + newflds(n)%merge_fields(:) = flds(n)%merge_fields(:) + newflds(n)%merge_types(:) = flds(n)%merge_types(:) + newflds(n)%merge_fracnames(:) = flds(n)%merge_fracnames(:) + end do + + ! 3) deallocate / nullify flds + if (oldsize > 0) then + deallocate(flds) + nullify(flds) + end if + + ! 4) point flds => new_flds + flds => newflds + + ! 5) now update flds information for new entry + flds(id)%stdname = trim(stdname) + if (present(shortname)) then + flds(id)%shortname = trim(shortname) + else + flds(id)%shortname = trim(stdname) + end if + end if + + end subroutine shr_nuopc_fldList_AddFld + + !================================================================================ + + subroutine shr_nuopc_fldList_AddMrg(flds, fldname, & + mrg_from1, mrg_fld1, mrg_type1, mrg_fracname1, & + mrg_from2, mrg_fld2, mrg_type2, mrg_fracname2, & + mrg_from3, mrg_fld3, mrg_type3, mrg_fracname3, & + mrg_from4, mrg_fld4, mrg_type4, mrg_fracname4) + + ! ---------------------------------------------- + ! Determine mrg entry or entries in flds aray + ! ---------------------------------------------- + + type(shr_nuopc_fldList_entry_type) , pointer :: flds(:) + character(len=*) , intent(in) :: fldname + integer , intent(in) , optional :: mrg_from1 + character(len=*) , intent(in) , optional :: mrg_fld1 + character(len=*) , intent(in) , optional :: mrg_type1 + character(len=*) , intent(in) , optional :: mrg_fracname1 + integer , intent(in) , optional :: mrg_from2 + character(len=*) , intent(in) , optional :: mrg_fld2 + character(len=*) , intent(in) , optional :: mrg_type2 + character(len=*) , intent(in) , optional :: mrg_fracname2 + integer , intent(in) , optional :: mrg_from3 + character(len=*) , intent(in) , optional :: mrg_fld3 + character(len=*) , intent(in) , optional :: mrg_type3 + character(len=*) , intent(in) , optional :: mrg_fracname3 + integer , intent(in) , optional :: mrg_from4 + character(len=*) , intent(in) , optional :: mrg_fld4 + character(len=*) , intent(in) , optional :: mrg_type4 + character(len=*) , intent(in) , optional :: mrg_fracname4 + + ! local variables + integer :: n, id + character(len=*), parameter :: subname='(shr_nuopc_fldList_MrgFld)' + ! ---------------------------------------------- + + id = 0 + do n= 1,size(flds) + if (trim(fldname) == trim(flds(n)%stdname)) then + id = n + exit + end if + end do + if (id == 0) then + do n = 1,size(flds) + write(6,*) trim(subname)//' input flds entry is ',trim(flds(n)%stdname) + end do + call shr_sys_abort(subname // 'ERROR: fldname '// trim(fldname) // ' not found in input flds') + end if + + if (present(mrg_from1) .and. present(mrg_fld1) .and. present(mrg_type1)) then + n = mrg_from1 + flds(id)%merge_fields(n) = mrg_fld1 + flds(id)%merge_types(n) = mrg_type1 + if (present(mrg_fracname1)) then + flds(id)%merge_fracnames(n) = mrg_fracname1 + end if + end if + if (present(mrg_from2) .and. present(mrg_fld2) .and. present(mrg_type2)) then + n = mrg_from2 + flds(id)%merge_fields(n) = mrg_fld2 + flds(id)%merge_types(n) = mrg_type2 + if (present(mrg_fracname2)) then + flds(id)%merge_fracnames(n) = mrg_fracname2 + end if + end if + if (present(mrg_from3) .and. present(mrg_fld3) .and. present(mrg_type3)) then + n = mrg_from3 + flds(id)%merge_fields(n) = mrg_fld3 + flds(id)%merge_types(n) = mrg_type3 + if (present(mrg_fracname3)) then + flds(id)%merge_fracnames(n) = mrg_fracname3 + end if + end if + if (present(mrg_from4) .and. present(mrg_fld4) .and. present(mrg_type4)) then + n = mrg_from4 + flds(id)%merge_fields(n) = mrg_fld4 + flds(id)%merge_types(n) = mrg_type4 + if (present(mrg_fracname4)) then + flds(id)%merge_fracnames(n) = mrg_fracname4 + end if + end if + + end subroutine shr_nuopc_fldList_AddMrg + + !================================================================================ + + subroutine shr_nuopc_fldList_AddMap(flds, fldname, destcomp, maptype, mapnorm, mapfile) + + ! intput/output variables + type(shr_nuopc_fldList_entry_type) , intent(inout) :: flds(:) + character(len=*) , intent(in) :: fldname + integer , intent(in) :: destcomp + integer , intent(in) :: maptype + character(len=*) , intent(in) :: mapnorm + character(len=*) , intent(in) :: mapfile + + ! local variables + integer :: id, n + character(len=*),parameter :: subname='(shr_nuopc_fldList_AddMap)' + ! ---------------------------------------------- + + id = 0 + do n = 1,size(flds) + if (trim(fldname) == trim(flds(n)%stdname)) then + id = n + exit + end if + end do + if (id == 0) then + do n = 1,size(flds) + write(6,*) trim(subname)//' input flds entry is ',trim(flds(n)%stdname) + end do + call shr_sys_abort(subname // 'ERROR: fldname '// trim(fldname) // ' not found in input flds') + end if + + ! Note - default values are already set for the fld entries - so only non-default + ! values need to be set below + ! If mapindex is mapfcopy - create a redistribution route handle + ! If mapfile is idmap - create a redistribution route nhandle + ! If mapfile is unset then create the mapping route handle at run time + + flds(id)%mapindex(destcomp) = maptype + flds(id)%mapnorm(destcomp) = trim(mapnorm) + flds(id)%mapfile(destcomp) = trim(mapfile) + + ! overwrite values if appropriate + if (flds(id)%mapindex(destcomp) == mapfcopy) then + flds(id)%mapfile(destcomp) = 'unset' + flds(id)%mapnorm(destcomp) = 'unset' + else if (trim(flds(id)%mapfile(destcomp)) == 'idmap') then + flds(id)%mapindex(destcomp) = mapfcopy + flds(id)%mapnorm(destcomp) = 'unset' + end if + + end subroutine shr_nuopc_fldList_AddMap + + !================================================================================ + + subroutine shr_nuopc_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num, & + grid, mesh, tag, rc) + + use NUOPC , only : NUOPC_GetStateMemberLists, NUOPC_IsConnected, NUOPC_Realize + use NUOPC , only : NUOPC_GetAttribute + use ESMF , only : ESMF_MeshLoc_Element, ESMF_FieldCreate, ESMF_TYPEKIND_R8 + use ESMF , only : ESMF_MAXSTR, ESMF_Field, ESMF_State, ESMF_Grid, ESMF_Mesh + use ESMF , only : ESMF_StateGet, ESMF_LogFoundError + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_LOGERR_PASSTHRU + use ESMF , only : ESMF_LOGMSG_INFO, ESMF_StateRemove, ESMF_SUCCESS + use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag + + ! input/output variables + type(ESMF_State) , intent(inout) :: state + type(shr_nuopc_fldlist_type), intent(in) :: fldList + character(len=*) , intent(in) :: flds_scalar_name + integer , intent(in) :: flds_scalar_num + character(len=*) , intent(in) :: tag + integer , intent(inout) :: rc + type(ESMF_Grid) , intent(in) , optional :: grid + type(ESMF_Mesh) , intent(in) , optional :: mesh + + ! local variables + integer :: n, nflds + integer :: itemCount + type(ESMF_Field) :: field + character(CS) :: shortname + character(CS) :: stdname + character(ESMF_MAXSTR) :: transferAction + character(ESMF_MAXSTR), pointer :: StandardNameList(:) + character(ESMF_MAXSTR), pointer :: ConnectedList(:) + character(ESMF_MAXSTR), pointer :: NameSpaceList(:) + character(ESMF_MAXSTR), pointer :: itemNameList(:) + character(len=*),parameter :: subname='(shr_nuopc_fldList_Realize)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + if (present(grid) .and. present(mesh)) then + call ESMF_LogWrite(trim(subname)//trim(tag)//": ERROR both grid and mesh not allowed", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + nullify(StandardNameList) + nullify(ConnectedList) + nullify(NameSpaceList) + nullify(ItemNameList) + + call ESMF_StateGet(state, itemCount=itemCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + write(infostr,'(i6)') itemCount + call ESMF_LogWrite(trim(subname)//trim(tag)//" count = "//trim(infostr), ESMF_LOGMSG_INFO, rc=dbrc) + if (itemCount > 0) then + allocate(itemNameList(itemCount)) + call ESMF_StateGet(state, itemNameList=itemNameList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + do n = 1,itemCount + call ESMF_LogWrite(trim(subname)//trim(tag)//" itemNameList = "//trim(itemNameList(n)), ESMF_LOGMSG_INFO, rc=dbrc) + enddo + deallocate(itemNameList) + endif + +#if (1 == 0) + call NUOPC_GetStateMemberLists(state, StandardNameList=StandardNameList, ConnectedList=ConnectedList, & + NamespaceList=NamespaceList, itemNameList=itemNameList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + write(infostr,'(i6)') size(StandardNameList) + call ESMF_LogWrite(trim(subname)//trim(tag)//" size = "//trim(infostr), ESMF_LOGMSG_INFO, rc=dbrc) + + do n = 1,size(StandardNameList) + call ESMF_LogWrite(trim(subname)//trim(tag)//" StandardNameList = "//trim(StandardNameList(n)), & + ESMF_LOGMSG_INFO, rc=dbrc) + enddo + do n = 1,size(ConnectedList) + call ESMF_LogWrite(trim(subname)//trim(tag)//" ConnectedList = "//trim(ConnectedList(n)), & + ESMF_LOGMSG_INFO, rc=dbrc) + enddo + do n = 1,size(NamespaceList) + call ESMF_LogWrite(trim(subname)//trim(tag)//" NamespaceList = "//trim(NamespaceList(n)), & + ESMF_LOGMSG_INFO, rc=dbrc) + enddo + do n = 1,size(ItemnameList) + call ESMF_LogWrite(trim(subname)//trim(tag)//" ItemnameList = "//trim(ItemnameList(n)), & + ESMF_LOGMSG_INFO, rc=dbrc) + enddo +#endif + + nflds = size(fldList%flds) + + do n = 1, nflds + shortname = fldList%flds(n)%shortname + + ! call ESMF_LogWrite(subname//' fld = '//trim(shortname), ESMF_LOGMSG_INFO, rc=dbrc) + if (NUOPC_IsConnected(state, fieldName=shortname)) then + + call ESMF_StateGet(state, field=field, itemName=trim(shortname), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + call NUOPC_GetAttribute(field, name="TransferActionGeomObject", value=transferAction, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + if (trim(transferAction) == "accept") then ! accept + + call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(shortname)//" is connected, grid/mesh TBD", & + ESMF_LOGMSG_INFO, rc=dbrc) + + else ! provide + + if (shortname == trim(flds_scalar_name)) then + call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(shortname)//" is connected on root pe", & + ESMF_LOGMSG_INFO, rc=dbrc) + call SetScalarField(field, flds_scalar_name, flds_scalar_num, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + elseif (present(grid)) then + call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(shortname)//" is connected using grid", & + ESMF_LOGMSG_INFO, rc=dbrc) + ! Create the field + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, name=shortname,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + elseif (present(mesh)) then + call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(shortname)//" is connected using mesh", & + ESMF_LOGMSG_INFO, rc=dbrc) + ! Create the field + field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=shortname, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//trim(tag)//": ERROR grid or mesh expected", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + ! NOW call NUOPC_Realize + call NUOPC_Realize(state, field=field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + ! call ESMF_FieldPrint(field=field, rc=rc) + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + endif + + else + + call ESMF_LogWrite(subname // trim(tag) // " Field = "// trim(shortname) // " is not connected.", & + ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_StateRemove(state, (/shortname/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + end if + + end do + + call ESMF_LogWrite(subname//' done ', ESMF_LOGMSG_INFO, rc=dbrc) + + contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + subroutine SetScalarField(field, flds_scalar_name, flds_scalar_num, rc) + ! ---------------------------------------------- + ! create a field with scalar data on the root pe + ! ---------------------------------------------- + use ESMF, only : ESMF_Field, ESMF_DistGrid, ESMF_Grid + use ESMF, only : ESMF_DistGridCreate, ESMF_GridCreate, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU + use ESMF, only : ESMF_FieldCreate, ESMF_GridCreate, ESMF_TYPEKIND_R8 + type(ESMF_Field) , intent(inout) :: field + character(len=*) , intent(in) :: flds_scalar_name + integer , intent(in) :: flds_scalar_num + integer , intent(inout) :: rc + + ! local variables + type(ESMF_Distgrid) :: distgrid + type(ESMF_Grid) :: grid + character(len=*), parameter :: subname='(SetScalarField)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + ! create a DistGrid with a single index space element, which gets mapped onto DE 0. + distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/1/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + grid = ESMF_GridCreate(distgrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + field = ESMF_FieldCreate(name=trim(flds_scalar_name), & + grid=grid, & + typekind=ESMF_TYPEKIND_R8, & + ungriddedLBound=(/1/), & + ungriddedUBound=(/flds_scalar_num/), & + gridToFieldMap=(/2/), & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + + end subroutine SetScalarField + + end subroutine shr_nuopc_fldList_Realize + + !================================================================================ + + subroutine shr_nuopc_fldList_GetFldInfo_general(fldList, fldindex, stdname, shortname) + ! ---------------------------------------------- + ! Get field info + ! ---------------------------------------------- + type(shr_nuopc_fldList_type) , intent(in) :: fldList + integer , intent(in) :: fldindex + character(len=*) , intent(out) :: stdname + character(len=*) , intent(out) :: shortname + + ! local variables + character(len=*), parameter :: subname='(shr_nuopc_fldList_GetFldInfo_general)' + ! ---------------------------------------------- + + stdname = fldList%flds(fldindex)%stdname + shortname = fldList%flds(fldindex)%shortname + + end subroutine shr_nuopc_fldList_GetFldInfo_general + + !================================================================================ + + subroutine shr_nuopc_fldList_GetFldInfo_stdname(fldList, fldindex, stdname) + ! ---------------------------------------------- + ! Get field info + ! ---------------------------------------------- + type(shr_nuopc_fldList_type) , intent(in) :: fldList + integer , intent(in) :: fldindex + character(len=*) , intent(out) :: stdname + + ! local variables + character(len=*), parameter :: subname='(shr_nuopc_fldList_GetFldInfo_stdname)' + ! ---------------------------------------------- + + stdname = fldList%flds(fldindex)%stdname + end subroutine shr_nuopc_fldList_GetFldInfo_stdname + + !================================================================================ + + subroutine shr_nuopc_fldList_GetFldInfo_merging(fldList, fldindex, compsrc, merge_field, merge_type, merge_fracname) + ! ---------------------------------------------- + ! Get field merge info + ! ---------------------------------------------- + type(shr_nuopc_fldList_type) , intent(in) :: fldList + integer , intent(in) :: fldindex + integer , intent(in) :: compsrc + character(len=*) , intent(out) :: merge_field + character(len=*) , intent(out) :: merge_type + character(len=*) , intent(out) :: merge_fracname + + ! local variables + character(len=*), parameter :: subname='(shr_nuopc_fldList_GetFldInfo_merging)' + ! ---------------------------------------------- + + merge_field = fldList%flds(fldindex)%merge_fields(compsrc) + merge_type = fldList%flds(fldindex)%merge_types(compsrc) + merge_fracname = fldList%flds(fldindex)%merge_fracnames(compsrc) + end subroutine shr_nuopc_fldList_GetFldInfo_merging + + !================================================================================ + + integer function shr_nuopc_fldList_GetNumFlds(fldList) + + ! input/output variables + type(shr_nuopc_fldList_type), intent(in) :: fldList + ! ---------------------------------------------- + + if (associated(fldList%flds)) then + shr_nuopc_fldList_GetNumFlds = size(fldList%flds) + else + shr_nuopc_fldList_GetNumFlds = 0 + end if + + end function shr_nuopc_fldList_GetNumFlds + + !================================================================================ + + subroutine shr_nuopc_fldList_GetFldNames(flds, fldnames, rc) + + use ESMF, only : ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_SUCCESS, ESMF_LogWrite + + ! input/output variables + type(shr_nuopc_fldList_entry_type) , pointer :: flds(:) + character(len=*) , pointer :: fldnames(:) + integer, optional , intent(out) :: rc + + !local variables + integer :: n + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + if (associated(flds) .and. associated(fldnames)) then + do n = 1,size(flds) + fldnames(n) = trim(flds(n)%shortname) + end do + else + call ESMF_LogWrite("shr_nuopc_fldList_GetFldNames: ERROR either flds or fldnames have not been allocate ", & + ESMF_LOGMSG_INFO, rc=rc) + rc=ESMF_FAILURE + return + end if + + end subroutine shr_nuopc_fldList_GetFldNames + + !================================================================================ + + subroutine shr_nuopc_fldList_Document_Mapping(logunit, med_coupling_active) + + ! input/output variables + integer, intent(in) :: logunit + logical, intent(in) :: med_coupling_active(:,:) + + ! local variables + integer :: nsrc,ndst,nf,nm,n + integer :: mapindex + character(len=CS) :: mapnorm + character(len=CL) :: mapfile + character(len=CS) :: fldname + character(len=CS) :: stdname + character(len=CX) :: merge_fields + character(len=CX) :: merge_field + character(len=CS) :: merge_type + character(len=CS) :: merge_fracname + character(len=CS) :: string + character(len=CL) :: mrgstr + character(len=CL) :: cvalue + logical :: init_mrgstr + character(len=*),parameter :: subname = '(shr_nuopc_fldList_Document_Mapping)' + !----------------------------------------------------------- + + !--------------------------------------- + ! Document mapping (also add albedo and aoflux) - move this routine to esmFlds.F90 + !--------------------------------------- + + ! Loop over src components + do nsrc = 1,ncomps + ! Loop over all possible destination components for each src component + do ndst = 1,ncomps + if (nsrc /= ndst .and. med_coupling_active(nsrc,ndst)) then + ! Write all the mappings for fields from the src to the destination component + write(logunit,*)' ' + do n = 1,size(fldListFr(nsrc)%flds) + mapindex = fldListFr(nsrc)%flds(n)%mapindex(ndst) + if ( mapindex /= mapunset) then + fldname = trim(fldListFr(nsrc)%flds(n)%stdname) + mapnorm = trim(fldListFr(nsrc)%flds(n)%mapnorm(ndst)) + mapfile = trim(fldListFr(nsrc)%flds(n)%mapfile(ndst)) + + if (trim(mapnorm) == 'unset') then + cvalue = ' mapping '//trim(compname(nsrc))//'->'//trim(compname(ndst)) //' '//trim(fldname) // & + ' via '// trim(mapnames(mapindex)) + else + cvalue = ' mapping '//trim(compname(nsrc))//'->'//trim(compname(ndst)) //' '//trim(fldname) // & + ' via '// trim(mapnames(mapindex)) // ' with '// trim(mapnorm) // ' normalization' + end if + write(logunit,100) trim(cvalue) + if (trim(mapfile) /= 'unset' .and. trim(mapfile) /= 'idmap') then + cvalue = ' and the mapping file '// trim(mapfile) + write(logunit,101) trim(cvalue) + end if + end if + end do + + end if + end do + end do + + ! ocn-> atm mappings for atm/ocn fluxes computed in mediator on the ocn grid + nsrc = compocn + ndst = compatm + if (med_coupling_active(nsrc,ndst)) then + do n = 1,size(fldListMed_aoflux%flds) + mapindex = fldlistMed_aoflux%flds(n)%mapindex(ndst) + if ( mapindex /= mapunset) then + fldname = trim(fldlistMed_aoflux%flds(n)%stdname) + mapnorm = trim(fldlistMed_aoflux%flds(n)%mapnorm(ndst)) + mapfile = trim(fldlistMed_aoflux%flds(n)%mapfile(ndst)) + + if (trim(mapnorm) == 'unset') then + cvalue = ' mapping '//trim(compname(nsrc))//'->'//trim(compname(ndst)) //' '//trim(fldname) // & + ' via '// trim(mapnames(mapindex)) + else + cvalue = ' mapping '//trim(compname(nsrc))//'->'//trim(compname(ndst)) //' '//trim(fldname) // & + ' via '// trim(mapnames(mapindex)) // ' with '// trim(mapnorm) // ' normalization' + end if + write(logunit,100) trim(cvalue) + if (trim(mapfile) /= 'unset' .and. trim(mapfile) /= 'idmap') then + cvalue = ' and the mapping file '// trim(mapfile) + write(logunit,101) trim(cvalue) + end if + end if + end do + end if + +100 format(a) +101 format(3x,a) + + end subroutine shr_nuopc_fldList_Document_Mapping + + !================================================================================ + + subroutine shr_nuopc_fldList_Document_Merging(logunit, med_coupling_active) + + !--------------------------------------- + ! Document merging to target destination fields + !--------------------------------------- + + ! input/output variables + integer, intent(in) :: logunit + logical, intent(in) :: med_coupling_active(:,:) + + ! local variables + integer :: nsrc,ndst,nf,n + character(len=CS) :: dst_comp + character(len=CS) :: dst_field + character(len=CS) :: src_comp + character(len=CS) :: src_field + character(len=CS) :: merge_type + character(len=CS) :: merge_field + character(len=CS) :: merge_frac + character(len=CS) :: prefix + character(len=CS) :: string + character(len=CL) :: mrgstr + logical :: init_mrgstr + character(len=*),parameter :: subname = '(shr_nuopc_fldList_Document_Mapping)' + !----------------------------------------------------------- + + write(logunit,*) + + ! Loop over destination components + do ndst = 1,ncomps + dst_comp = trim(compname(ndst)) + prefix = '(merge_to_'//trim(dst_comp)//')' + + ! Loop over all flds in the destination component and determine merging data + do nf = 1,size(fldListTo(ndst)%flds) + dst_field = fldListTo(ndst)%flds(nf)%stdname + + ! Loop over all possible source components for destination component field + mrgstr = ' ' + do nsrc = 1,ncomps + + if (nsrc /= ndst .and. med_coupling_active(nsrc,ndst)) then + src_comp = compname(nsrc) + merge_field = fldListTo(ndst)%flds(nf)%merge_fields(nsrc) + merge_type = fldListTo(ndst)%flds(nf)%merge_types(nsrc) + merge_frac = fldListTo(ndst)%flds(nf)%merge_fracnames(nsrc) + + if (merge_type == 'merge' .or. merge_type == 'sum_with_weights') then + string = trim(merge_frac)//'*'//trim(merge_field)//'('//trim(src_comp)//')' + if (mrgstr == ' ') then + mrgstr = trim(prefix)//": "// trim(dst_field) //'('//trim(dst_comp)//')'//' = '//trim(string) + else + mrgstr = trim(mrgstr) //' + '//trim(string) + end if + else if (merge_type == 'sum') then + string = trim(merge_field)//'('//trim(src_comp)//')' + if (mrgstr == ' ') then + mrgstr = trim(prefix)//": "//trim(dst_field) //'('//trim(dst_comp)//')'//' = '//trim(string) + else + mrgstr = trim(mrgstr) //' + '//trim(string) + end if + else + if (merge_type == 'copy') then + mrgstr = trim(prefix)//": " // trim(dst_field) //'('//trim(dst_comp)//')'//' = '// & + trim(merge_field)//'('//trim(src_comp)//')' + else if (merge_type == 'copy_with_weights') then + mrgstr = trim(prefix)//": "// trim(dst_field) //'('//trim(dst_comp)//')'//' = '// & + trim(merge_frac)//'*'//trim(merge_field)//'('//trim(src_comp)//')' + end if + end if + end if + + end do ! end loop over nsrc + if (mrgstr /= ' ') then + write(logunit,'(a)') trim(mrgstr) + end if + end do ! end loop over nf + !write(logunit,*)' ' + end do ! end loop over ndst + + end subroutine shr_nuopc_fldList_Document_Merging + +end module esmflds diff --git a/src/exch_flds/esmFldsExchange.F90 b/src/exch_flds/esmFldsExchange.F90 new file mode 100644 index 00000000..f0546086 --- /dev/null +++ b/src/exch_flds/esmFldsExchange.F90 @@ -0,0 +1,2084 @@ +module esmFldsExchange_mod + + !--------------------------------------------------------------------- + ! This is a mediator specific routine that determines ALL possible + ! fields exchanged between components and their associated routing, + ! mapping and merging + !--------------------------------------------------------------------- + + implicit none + public + + public :: esmFldsExchange + + character(*), parameter :: u_FILE_u = & + __FILE__ + +!================================================================================ +contains +!================================================================================ + + subroutine esmFldsExchange(gcomp, phase, rc) + + use ESMF + use NUOPC + use med_constants_mod , only : CX, CS, CL + use shr_nuopc_scalars_mod , only : flds_scalar_name + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_chkerr + use shr_nuopc_methods_mod , only : fldchk => shr_nuopc_methods_FB_FldChk + use med_internalstate_mod , only : InternalState + use glc_elevclass_mod , only : glc_elevclass_as_string + use shr_sys_mod , only : shr_sys_abort + use esmFlds , only : shr_nuopc_fldList_type + use esmFlds , only : addfld => shr_nuopc_fldList_AddFld + use esmFlds , only : addmap => shr_nuopc_fldList_AddMap + use esmFlds , only : addmrg => shr_nuopc_fldList_AddMrg + use esmflds , only : compmed, compatm, complnd, compocn + use esmflds , only : compice, comprof, compwav, compglc, ncomps + use esmflds , only : mapbilnr, mapconsf, mapconsd, mappatch + use esmflds , only : mapfcopy, mapfiler, mapnstod, mapnstod_consd, mapnstod_consf + use esmflds , only : fldListTo, fldListFr, fldListMed_aoflux, fldListMed_ocnalb + use esmFlds , only : coupling_mode + + ! input/output parameters: + type(ESMF_GridComp) :: gcomp + character(len=*) , intent(in) :: phase + integer , intent(inout) :: rc + + ! local variables: + type(InternalState) :: is_local + integer :: ice_ncat ! number of sea ice thickness categories + integer :: glc_nec ! number of land-ice elevation classes + integer :: max_megan + integer :: max_ddep + integer :: max_fire + logical :: flds_i2o_per_cat + integer :: dbrc + integer :: num, i, n + integer :: n1, n2, n3, n4 + character(len=4) :: iso(4) + character(len=3) :: cnum + character(len=CL) :: cvalue + character(len=CS) :: name, fldname + character(len=CX) :: atm2ice_fmap, atm2ice_smap, atm2ice_vmap + character(len=CX) :: atm2ocn_fmap, atm2ocn_smap, atm2ocn_vmap + character(len=CX) :: atm2lnd_fmap, atm2lnd_smap + character(len=CX) :: glc2lnd_smap, glc2lnd_fmap + character(len=CX) :: glc2ice_rmap + character(len=CX) :: glc2ocn_liq_rmap, glc2ocn_ice_rmap + character(len=CX) :: ice2atm_fmap, ice2atm_smap + character(len=CX) :: ocn2atm_fmap, ocn2atm_smap + character(len=CX) :: lnd2atm_fmap, lnd2atm_smap + character(len=CX) :: lnd2glc_fmap, lnd2glc_smap + character(len=CX) :: lnd2rof_fmap + character(len=CX) :: rof2lnd_fmap + character(len=CX) :: rof2ocn_fmap, rof2ocn_ice_rmap, rof2ocn_liq_rmap + character(len=CX) :: atm2wav_smap, ice2wav_smap, ocn2wav_smap + character(len=CX) :: wav2ocn_smap + logical :: flds_co2a ! use case + logical :: flds_co2b ! use case + logical :: flds_co2c ! use case + character(len=64), allocatable :: flds(:) + character(len=64), allocatable :: suffix(:) + character(len=*), parameter :: subname='(esmFldsExchange)' + !-------------------------------------- + + rc = ESMF_SUCCESS + + !--------------------------------------- + ! Get the internal state + !--------------------------------------- + + if (phase /= 'advertise') then + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + !---------------------------------------------------------- + ! Determine supported coupling model + !---------------------------------------------------------- + + if (phase /= 'advertise') then + + ! CESM Default settings + coupling_mode = 'cesm' + + if ( fldchk(is_local%wrap%FBexp(compatm) , 'Faxx_taux', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_taux', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_taux', rc=rc)) then + + ! NEMS orig + ! atm receives merged atm/ocn fluxes computed in mediator and + ! atm/ice and fluxes computed in ice. The atm/ocn fluxes are + ! only used for gridcells that If no interpolated values can be + ! obtained over ocn/ice gridcells on the atm grid (using + ! bilinear or conservative methods), the interpolated values + ! from the nearest neighbor method will be used. + + coupling_mode = 'nems_orig' + + else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Faii_taux', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_taux', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_taux', rc=rc)) then + + ! NEMS frac + ! atm receives atm/ice fluxes computed in the ice component and returns merged + ! lnd/ice/ocn surface fluxes and states back to the mediator + + coupling_mode = 'nems_frac' + + end if + end if + + !-------------------------------------- + ! Merging arguments: + ! mrg_fromN = source component index that for the field to be merged + ! mrg_fldN = souce field name to be merged + ! mrg_typeN = merge type ('copy', 'copy_with_weights', 'sum', 'sum_with_weights', 'merge') + ! NOTE: + ! mrg_from(compmed) can either be for mediator computed fields for atm/ocn fluxes or for ocn albedos + ! + ! NOTE: + ! FBMed_aoflux_o only refer to output fields to the atm/ocn that computed in the + ! atm/ocn flux calculations. Input fields required from either the atm or the ocn for + ! these computation will use the logical 'use_med_aoflux' below. This is used to determine + ! mappings between the atm and ocn needed for these computations. + !-------------------------------------- + + !--------------------------- + ! For now hardwire these + !--------------------------- + + ! these must be less than or equal to the values in fd.yaml + max_megan = 20 + max_ddep = 80 + max_fire = 10 + glc_nec = 10 + ice_ncat = 5 + flds_i2o_per_cat = .true. + + iso(1) = '' + iso(2) = '_16O' + iso(3) = '_18O' + iso(4) = '_HDO' + + !---------------------------------------------------------- + ! Initialize mapping file names + !---------------------------------------------------------- + + ! to atm + + call NUOPC_CompAttributeGet(gcomp, name='ice2atm_fmapname', value=ice2atm_fmap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('ice2atm_fmapname = '// trim(ice2atm_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='ice2atm_smapname', value=ice2atm_smap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('ice2atm_smapname = '// trim(ice2atm_smap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='lnd2atm_fmapname', value=lnd2atm_fmap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('lnd2atm_fmapname = '// trim(lnd2atm_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='ocn2atm_smapname', value=ocn2atm_smap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('ocn2atm_smapname = '// trim(ocn2atm_smap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='ocn2atm_fmapname', value=ocn2atm_fmap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('ocn2atm_fmapname = '// trim(ocn2atm_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='lnd2atm_smapname', value=lnd2atm_smap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('lnd2atm_smapname = '// trim(lnd2atm_smap), ESMF_LOGMSG_INFO, rc=dbrc) + + ! to lnd + + call NUOPC_CompAttributeGet(gcomp, name='atm2lnd_fmapname', value=atm2lnd_fmap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('atm2lnd_fmapname = '// trim(atm2lnd_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='atm2lnd_smapname', value=atm2lnd_smap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('atm2lnd_smapname = '// trim(atm2lnd_smap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='rof2lnd_fmapname', value=rof2lnd_fmap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('rof2lnd_fmapname = '// trim(rof2lnd_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='glc2lnd_fmapname', value=glc2lnd_fmap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('glc2lnd_smapname = '// trim(glc2lnd_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='glc2lnd_smapname', value=glc2lnd_smap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('glc2lnd_smapname = '// trim(glc2lnd_smap), ESMF_LOGMSG_INFO, rc=dbrc) + + ! to ice + + call NUOPC_CompAttributeGet(gcomp, name='atm2ice_fmapname', value=atm2ice_fmap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('atm2ice_fmapname = '// trim(atm2ice_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='atm2ice_smapname', value=atm2ice_smap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('atm2ice_smapname = '// trim(atm2ice_smap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='atm2ice_vmapname', value=atm2ice_vmap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('atm2ice_vmapname = '// trim(atm2ice_vmap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='glc2ice_rmapname', value=glc2ice_rmap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('glc2ice_rmapname = '// trim(glc2ice_rmap), ESMF_LOGMSG_INFO, rc=dbrc) + + ! to ocn + + call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_fmapname', value=atm2ocn_fmap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('atm2ocn_fmapname = '// trim(atm2ocn_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_smapname', value=atm2ocn_smap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('atm2ocn_smapname = '// trim(atm2ocn_smap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_vmapname', value=atm2ocn_vmap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('atm2ocn_vmapname = '// trim(atm2ocn_vmap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='glc2ocn_liq_rmapname', value=glc2ocn_liq_rmap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('glc2ocn_liq_rmapname = '// trim(glc2ocn_liq_rmap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='glc2ocn_ice_rmapname', value=glc2ocn_ice_rmap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('glc2ocn_ice_rmapname = '// trim(glc2ocn_ice_rmap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='wav2ocn_smapname', value=wav2ocn_smap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('wav2ocn_smapname = '// trim(wav2ocn_smap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_fmapname', value=rof2ocn_fmap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('rof2ocn_fmapname = '// trim(rof2ocn_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_liq_rmapname', value=rof2ocn_liq_rmap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('rof2ocn_liq_rmapname = '// trim(rof2ocn_liq_rmap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_ice_rmapname', value=rof2ocn_ice_rmap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('rof2ocn_ice_rmapname = '// trim(rof2ocn_ice_rmap), ESMF_LOGMSG_INFO, rc=dbrc) + + ! to rof + + call NUOPC_CompAttributeGet(gcomp, name='lnd2rof_fmapname', value=lnd2rof_fmap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('lnd2rof_fmapname = '// trim(lnd2rof_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + + ! to glc + + call NUOPC_CompAttributeGet(gcomp, name='lnd2glc_fmapname', value=lnd2glc_fmap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('lnd2glc_fmapname = '// trim(lnd2glc_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='lnd2glc_smapname', value=lnd2glc_smap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('lnd2glc_smapname = '// trim(lnd2glc_smap), ESMF_LOGMSG_INFO, rc=dbrc) + + ! to wav + + call NUOPC_CompAttributeGet(gcomp, name='atm2wav_smapname', value=atm2wav_smap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('atm2wav_smapname = '// trim(atm2wav_smap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='ice2wav_smapname', value=ice2wav_smap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('ice2wav_smapname = '// trim(ice2wav_smap), ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_CompAttributeGet(gcomp, name='ocn2wav_smapname', value=ocn2wav_smap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite('ocn2wav_smapname = '// trim(ocn2wav_smap), ESMF_LOGMSG_INFO, rc=dbrc) + + !===================================================================== + ! scalar information + !===================================================================== + + if (phase == 'advertise') then + do n = 1,ncomps + call addfld(fldListFr(n)%flds, trim(flds_scalar_name)) + call addfld(fldListTo(n)%flds, trim(flds_scalar_name)) + end do + end if + + !===================================================================== + ! FIELDS TO MEDIATOR component (for fractions and atm/ocn flux calculation) + !===================================================================== + + !---------------------------------------------------------- + ! to med: masks from components + !---------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Sl_lfrin') + call addfld(fldListFr(compocn)%flds, 'So_omask') + call addfld(fldListFr(compice)%flds, 'Si_imask') + else + call addmap(fldListFr(compocn)%flds, 'So_omask', compice, mapfcopy, 'unset', 'unset') + end if + + ! --------------------------------------------------------------------- + ! to med: atm and ocn fields required for atm/ocn flux calculation' + ! --------------------------------------------------------------------- + if (phase /= 'advertise') then + if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'nems_orig') then + + call addfld(fldListFr(compatm)%flds, 'Sa_u') + call addmap(fldListFr(compatm)%flds, 'Sa_u' , compocn, mappatch, 'one', atm2ocn_vmap) + + call addfld(fldListFr(compatm)%flds, 'Sa_v') + call addmap(fldListFr(compatm)%flds, 'Sa_v' , compocn, mappatch, 'one', atm2ocn_vmap) + + call addfld(fldListFr(compatm)%flds, 'Sa_z') + call addmap(fldListFr(compatm)%flds, 'Sa_z' , compocn, mapbilnr, 'one', atm2ocn_smap) + + call addfld(fldListFr(compatm)%flds, 'Sa_tbot') + call addmap(fldListFr(compatm)%flds, 'Sa_tbot', compocn, mapbilnr, 'one', atm2ocn_smap) + + call addfld(fldListFr(compatm)%flds, 'Sa_pbot') + call addmap(fldListFr(compatm)%flds, 'Sa_pbot', compocn, mapbilnr, 'one', atm2ocn_smap) + + do n = 1,size(iso) + call addfld(fldListFr(compatm)%flds, 'Sa_shum'//iso(n)) + call addmap(fldListFr(compatm)%flds, 'Sa_shum'//iso(n), compocn, mapbilnr, 'one', atm2ocn_smap) + end do + + if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_ptem', rc=rc)) then + call addfld(fldListFr(compatm)%flds, 'Sa_ptem') + call addmap(fldListFr(compatm)%flds, 'Sa_ptem', compocn, mapbilnr, 'one', atm2ocn_smap) + end if + + if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_dens', rc=rc)) then + call addfld(fldListFr(compatm)%flds, 'Sa_dens') + call addmap(fldListFr(compatm)%flds, 'Sa_dens', compocn, mapbilnr, 'one', atm2ocn_smap) + end if + end if + end if + + ! --------------------------------------------------------------------- + ! to med: swnet fluxes used for budget calculation + ! --------------------------------------------------------------------- + ! TODO (mvertens, 2019-01-11): budget implemention needs to be done in CMEPS + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Fall_swnet') + call addfld(fldListFr(compice)%flds, 'Faii_swnet') + call addfld(fldListFr(compatm)%flds, 'Faxa_swnet') + else + if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swnet', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_swnet', compice, mapconsf, 'one' , atm2ice_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_swnet', compocn, mapconsf, 'one' , atm2ocn_fmap) + end if + if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_swnet', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Faii_swnet', compocn, mapfcopy, 'unset', 'unset') + end if + end if + + !===================================================================== + ! FIELDS TO LAND + !===================================================================== + + ! --------------------------------------------------------------------- + ! from atm: + ! to lnd: height at the lowest model level from atm + ! to lnd: surface height from atm + ! to lnd: zonal wind at the lowest model level from atm + ! to lnd: meridional wind at the lowest model level from atm + ! to lnd: Temperature at the lowest model level from atm + ! to lnd: potential temperature at the lowest model level from atm + ! to lnd: Pressure at the lowest model level from atm + ! to lnd: specific humidity at the lowest model level from atm + ! --------------------------------------------------------------------- + + allocate(flds(11)) + flds = (/'Sa_z', 'Sa_topo', 'Sa_u', 'Sa_v', 'Sa_tbot', 'Sa_ptem', & + 'Sa_pbot', 'Sa_shum', 'Sa_shum_16O', 'Sa_shum_18O', 'Sa_shum_HDO'/) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(complnd)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBexp(complnd) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), trim(fldname), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(fldname), complnd, mapbilnr, 'one', atm2lnd_smap) + call addmrg(fldListTo(complnd)%flds, trim(fldname), & + mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(flds) + + ! --------------------------------------------------------------------- + ! to lnd: convective and large scale precipitation rate water equivalent from atm + ! to lnd: convective and large-scale (stable) snow rate from atm + ! to lnd: downward longwave heat flux from atm + ! to lnd: downward direct near-infrared incident solar radiation from atm + ! to lnd: downward direct visible incident solar radiation from atm + ! to lnd: downward diffuse near-infrared incident solar radiation from atm + ! to lnd: downward Diffuse visible incident solar radiation from atm + ! to lnd: hydrophylic black carbon dry deposition flux from atm + ! to lnd: hydrophobic black carbon dry deposition flux from atm + ! to lnd: hydrophylic black carbon wet deposition flux from atm + ! to lnd: hydrophylic organic carbon dry deposition flux from atm + ! to lnd: hydrophobic organic carbon dry deposition flux from atm + ! to lnd: hydrophylic organic carbon wet deposition flux from atm + ! to lnd: dust wet deposition flux (size 1) from atm + ! to lnd: dust wet deposition flux (size 2) from atm + ! to lnd: dust wet deposition flux (size 3) from atm + ! to lnd: dust wet deposition flux (size 4) from atm + ! to lnd: dust dry deposition flux (size 1) from atm + ! to lnd: dust dry deposition flux (size 2) from atm + ! to lnd: dust dry deposition flux (size 3) from atm + ! to lnd: dust dry deposition flux (size 4) from atm + ! to lnd: nitrogen deposition fields from atm + ! --------------------------------------------------------------------- + + ! TODO (mvertens, 2019-12-13): the nitrogen deposition fluxes here + ! are not treated the same was as in cesm2.0 release + + allocate(flds(25)) + flds = (/'Faxa_rainc' , 'Faxa_rainl' , 'Faxa_snowc' , 'Faxa_snowl', & + 'Faxa_lwdn' , 'Faxa_swndr' , 'Faxa_swvdr' , 'Faxa_swndf', 'Faxa_swvdf', & + 'Faxa_bcphidry' , 'Faxa_bcphodry', 'Faxa_bcphiwet', & + 'Faxa_ocphidry' , 'Faxa_ocphodry', 'Faxa_ocphiwet', & + 'Faxa_dstwet1' , 'Faxa_dstwet2' , 'Faxa_dstwet3' , 'Faxa_dstwet4', & + 'Faxa_dstdry1' , 'Faxa_dstdry2' , 'Faxa_dstdry3' , 'Faxa_dstdry4', & + 'Faxa_noy' , 'Faxa_nhx'/) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(complnd)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBexp(complnd) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), trim(fldname), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(fldname), complnd, mapconsf, 'one', atm2lnd_fmap) + call addmrg(fldListTo(complnd)%flds, trim(fldname), & + mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(flds) + + ! --------------------------------------------------------------------- + ! to lnd: river channel total water volume from rof + ! to lnd: river channel main channel water volume from rof + ! to lnd: river water flux back to land due to flooding + ! --------------------------------------------------------------------- + allocate(flds(12)) + flds = (/'Flrr_volr' , 'Flrr_volr_16O' , 'Flrr_volr_18O' , 'Flrr_volr_HDO' , & + 'Flrr_volrmch', 'Flrr_volrmch_16O', 'Flrr_volrmch_18O', 'Flrr_volrmch_HDO', & + 'Flrr_flood' , 'Flrr_flood_16O' , 'Flrr_flood_18O' , 'Flrr_flood_HDO' /) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(comprof)%flds, trim(fldname)) + call addfld(fldListTo(complnd)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBExp(complnd) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), trim(fldname), rc=rc)) then + call addmap(fldListFr(comprof)%flds, trim(fldname), complnd, mapconsf, 'one', rof2lnd_fmap) + call addmrg(fldListTo(complnd)%flds, trim(fldname), & + mrg_from1=comprof, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(flds) + + ! --------------------------------------------------------------------- + ! to lnd: ice sheet grid coverage on global grid from glc + ! to lnd: ice sheet mask where we are potentially sending non-zero fluxes from glc + ! to lnd: fields with multiple elevation classes from glc + ! --------------------------------------------------------------------- + allocate(flds(2)) + flds = (/'Sg_icemask', 'Sg_icemask_coupled_fluxes'/) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compglc)%flds , trim(fldname)) + call addfld(fldListTo(complnd)%flds , trim(fldname)) + else + if ( fldchk(is_local%wrap%FBExp(complnd) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compglc, compglc), trim(fldname), rc=rc)) then + call addmap(fldListFr(compglc)%flds, trim(fldname), complnd, mapconsf, 'one', glc2lnd_smap) + call addmrg(fldListTo(complnd)%flds, trim(fldname), & + mrg_from1=compglc, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(flds) + + ! for glc fields with multiple elevation classes in glc->lnd + ! fields from glc->med do NOT have elevation classes + ! fields from med->lnd are BROKEN into multiple elevation classes + + if (glc_nec > 0) then + if (phase == 'advertise') then + call addfld(fldListFr(compglc)%flds, 'Sg_ice_covered') ! fraction of glacier area + call addfld(fldListFr(compglc)%flds, 'Sg_topo') ! surface height of glacer + call addfld(fldListFr(compglc)%flds, 'Flgg_hflx') ! downward heat flux from glacier interior + do num = 0, glc_nec + cnum = glc_elevclass_as_string(num) + call addfld(fldListTo(complnd)%flds, 'Sg_ice_covered'//trim(cnum)) + call addfld(fldListTo(complnd)%flds, 'Sg_topo'//trim(cnum)) + call addfld(fldListTo(complnd)%flds, 'Flgg_hflx'//trim(cnum)) + end do + else + do num = 0, glc_nec + cnum = glc_elevclass_as_string(num) + if ( fldchk(is_local%wrap%FBExp(complnd) , 'Sg_ice_covered'//trim(cnum), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(complnd) , 'Sg_topo'//trim(cnum) , rc=rc) .and. & + fldchk(is_local%wrap%FBExp(complnd) , 'Flgg_hflx'//trim(cnum) , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Sg_ice_covered' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Sg_topo' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Flgg_hflx' , rc=rc)) then + if (num == 0) then + call addmap(FldListFr(compglc)%flds, 'Sg_ice_covered' , complnd, mapconsf, 'unset' , glc2lnd_fmap) + call addmap(FldListFr(compglc)%flds, 'Sg_topo' , compglc, mapconsf, 'custom', glc2lnd_fmap) + call addmap(FldListFr(compglc)%flds, 'Flgg_hflx' , compglc, mapconsf, 'custom', glc2lnd_fmap) + end if + call addmrg(fldListTo(complnd)%flds, 'Sg_ice_covered'//trim(cnum), & + mrg_from1=compglc, mrg_fld1='Sg_ice_covered'//trim(cnum), mrg_type1='copy') + call addmrg(fldListTo(complnd)%flds, 'Sg_topo' //trim(cnum), & + mrg_from1=compglc, mrg_fld1='Sg_topo'//trim(cnum), mrg_type1='copy') + call addmrg(fldListTo(complnd)%flds, 'Flgg_hflx'//trim(cnum), & + mrg_from1=compglc, mrg_fld1='Flgg_hflx'//trim(cnum), mrg_type1='copy') + end if + end do + end if + end if + + !===================================================================== + ! FIELDS TO ATMOSPHERE + !===================================================================== + + !---------------------------------------------------------- + ! to atm: Fractions + !---------------------------------------------------------- + if (phase == 'advertise') then + ! the following are computed in med_phases_prep_atm + call addfld(fldListTo(compatm)%flds, 'Sl_lfrac') + call addfld(fldListTo(compatm)%flds, 'Si_ifrac') + call addfld(fldListTo(compatm)%flds, 'So_ofrac') + end if + + ! --------------------------------------------------------------------- + ! to atm: merged direct albedo (visible radiation) + ! to atm: merged diffuse albedo (visible radiation) + ! to atm: merged direct albedo (near-infrared radiation) + ! to atm: merged diffuse albedo (near-infrared radiation) + ! --------------------------------------------------------------------- + allocate(suffix(4)) + suffix = (/'avsdr', 'avsdf', 'anidr', 'anidf'/) + + do n = 1,size(suffix) + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Sl_'//trim(suffix(n))) + call addfld(fldListFr(compice)%flds, 'Si_'//trim(suffix(n))) + call addfld(fldListMed_ocnalb%flds , 'So_'//trim(suffix(n))) + call addfld(fldListTo(compatm)%flds, 'Sx_'//trim(suffix(n))) + else + ! CESM (cam, non-aqua-planet) + if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sx_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Si_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBMed_ocnalb_a , 'So_'//trim(suffix(n)), rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Sl_'//trim(suffix(n)), compatm, mapconsf, 'lfrin', lnd2atm_smap) + call addmap(fldListFr(compice)%flds, 'Si_'//trim(suffix(n)), compatm, mapconsf, 'ifrac', ice2atm_smap) + call addmap(fldListMed_ocnalb%flds , 'So_'//trim(suffix(n)), compatm, mapconsf, 'ofrac', ocn2atm_smap) + call addmrg(fldListTo(compatm)%flds, 'Sx_'//trim(suffix(n)), & + mrg_from1=complnd, mrg_fld1='Sl_'//trim(suffix(n)), mrg_type1='merge', mrg_fracname1='lfrac', & + mrg_from2=compice, mrg_fld2='Si_'//trim(suffix(n)), mrg_type2='merge', mrg_fracname2='ifrac', & + mrg_from3=compmed, mrg_fld3='So_'//trim(suffix(n)), mrg_type3='merge', mrg_fracname3='ofrac') + + ! CESM (cam, aqua-planet) + else if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm), 'Sx_'//trim(suffix(n)), rc=rc)) then + call addmap(fldListMed_ocnalb%flds , 'So_'//trim(suffix(n)), compatm, mapconsf, 'ofrac', ocn2atm_smap) + call addmrg(fldListTo(compatm)%flds, 'Sx_'//trim(suffix(n)), & + mrg_from1=compmed, mrg_fld1='So_'//trim(suffix(n)), mrg_type1='merge', mrg_fracname1='ofrac') + end if + end if + end do + deallocate(suffix) + + ! --------------------------------------------------------------------- + ! to atm: merged reference temperature at 2 meters + ! to atm: merged 10m wind speed + ! to atm: merged reference specific humidity at 2 meters + ! to atm: merged reference specific water isoptope humidity at 2 meters + ! --------------------------------------------------------------------- + allocate(suffix(6)) + suffix = (/'tref', 'u10', 'qref', 'qref_16O', 'qref_18O', 'qref_HDO'/) + + do n = 1,size(suffix) + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds , 'Sl_'//trim(suffix(n))) + call addfld(fldListFr(compice)%flds , 'Si_'//trim(suffix(n))) + call addfld(fldListMed_aoflux%flds , 'So_'//trim(suffix(n))) + call addfld(fldListTo(compatm)%flds , 'Sx_'//trim(suffix(n))) + else + ! CESM (cam, non-aqua-planet) + if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sx_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'So_'//trim(suffix(n)), rc=rc)) then + call addmap(fldListFr(complnd)%flds , 'Sl_'//trim(suffix(n)), compatm, mapconsf, 'lfrin', lnd2atm_fmap) + call addmap(fldListFr(compice)%flds , 'Si_'//trim(suffix(n)), compatm, mapconsf, 'ifrac', ice2atm_fmap) + call addmap(fldListMed_aoflux%flds , 'So_'//trim(suffix(n)), compocn, mapbilnr, 'one' , atm2ocn_fmap) ! map atm->ocn + call addmap(fldListMed_aoflux%flds , 'So_'//trim(suffix(n)), compatm, mapconsf, 'ofrac', ocn2atm_fmap) ! map ocn->atm + call addmrg(fldListTo(compatm)%flds , 'Sx_'//trim(suffix(n)), & + mrg_from1=complnd, mrg_fld1='Sl_'//trim(suffix(n)), mrg_type1='merge', mrg_fracname1='lfrac', & + mrg_from2=compice, mrg_fld2='Si_'//trim(suffix(n)), mrg_type2='merge', mrg_fracname2='ifrac', & + mrg_from3=compmed, mrg_fld3='So_'//trim(suffix(n)), mrg_type3='merge', mrg_fracname3='ofrac') + + ! NEMS-orig - merged ocn temp + else if (fldchk(is_local%wrap%FBexp(compatm) , 'Sx_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Si_'//trim(suffix(n)), rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Si_'//trim(suffix(n)), compatm, mapnstod_consf, 'ifrac', ice2atm_fmap) + call addmap(fldListFr(compocn)%flds, 'So_'//trim(suffix(n)), compatm, mapnstod_consf, 'none' , ocn2atm_fmap) + call addmrg(fldListTo(compatm)%flds, 'Sx_'//trim(suffix(n)), & + mrg_from1=compice, mrg_fld1='Si_'//trim(suffix(n)), mrg_type1='merge', mrg_fracname1='ifrac', & + mrg_from2=compocn, mrg_fld2='So_'//trim(suffix(n)), mrg_type2='merge', mrg_fracname2='ofrac') + + ! CESM (cam, aqua-planet) + else if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_'//trim(suffix(n)), rc=rc)) then + call addmap(fldListMed_aoflux%flds , 'So_'//trim(suffix(n)), compatm, mapconsf, 'ofrac', ocn2atm_fmap) ! map ocn->atm + call addmrg(fldListTo(compatm)%flds, 'Sx_'//trim(suffix(n)), & + mrg_from1=compmed, mrg_fld1='So_'//trim(suffix(n)), mrg_type1='merge', mrg_fracname1='ofrac') + end if + end if + end do + deallocate(suffix) + + ! --------------------------------------------------------------------- + ! to atm: merged zonal surface stress + ! to atm: merged meridional surface stress + ! to atm: merged surface latent heat flux + ! to atm: merged surface sensible heat flux + ! to atm: merged surface upward longwave heat flux + ! to atm: evaporation water flux from water + ! to atm: evaporation water flux from water isotopes + ! --------------------------------------------------------------------- + allocate(suffix(9)) + suffix = (/'taux', 'tauy', 'lat', 'sen', 'lwup', 'evap', 'evap_16O', 'evap_18O', 'evap_HDO' /) + + do n = 1,size(suffix) + if (phase == 'advertise') then + call addfld(fldListMed_aoflux%flds , 'Faox_'//trim(suffix(n))) + call addfld(fldListFr(complnd)%flds, 'Fall_'//trim(suffix(n))) + call addfld(fldListFr(compice)%flds, 'Faii_'//trim(suffix(n))) + call addfld(fldListTo(compatm)%flds, 'Faii_'//trim(suffix(n))) ! nems-frac + call addfld(fldListTo(compatm)%flds, 'Faxx_'//trim(suffix(n))) ! cesm, nems-orig + else + ! CESM (non aqua-planet) + if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faxx_'//trim(suffix(n)), rc=rc)) then + call addmap(fldListMed_aoflux%flds , 'Faox_'//trim(suffix(n)), compatm, mapconsf, 'ofrac', ocn2atm_fmap) + call addmap(fldListFr(complnd)%flds , 'Fall_'//trim(suffix(n)), compatm, mapconsf, 'lfrin', lnd2atm_fmap) + call addmap(fldListFr(compice)%flds , 'Faii_'//trim(suffix(n)), compatm, mapconsf, 'ifrac', ice2atm_fmap) + call addmrg(fldListTo(compatm)%flds , 'Faxx_'//trim(suffix(n)), & + mrg_from1=complnd, mrg_fld1='Fall_'//trim(suffix(n)), mrg_type1='merge', mrg_fracname1='lfrac', & + mrg_from2=compice, mrg_fld2='Faii_'//trim(suffix(n)), mrg_type2='merge', mrg_fracname2='ifrac', & + mrg_from3=compmed, mrg_fld3='Faox_'//trim(suffix(n)), mrg_type3='merge', mrg_fracname3='ofrac') + + ! NEMS orig (here ofrac = 1.-ifrac) + else if ( fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faxx_'//trim(suffix(n)), rc=rc)) then + call addmap(fldListMed_aoflux%flds , 'Faox_'//trim(suffix(n)), compatm, mapnstod_consf, 'none' , ocn2atm_fmap) + call addmap(fldListFr(compice)%flds , 'Faii_'//trim(suffix(n)), compatm, mapnstod_consf, 'ifrac', ice2atm_fmap) + call addmrg(fldListTo(compatm)%flds , 'Faxx_'//trim(suffix(n)), & + mrg_from1=compice, mrg_fld1='Faii_'//trim(suffix(n)), mrg_type1='merge', mrg_fracname1='ifrac', & + mrg_from2=compmed, mrg_fld2='Faox_'//trim(suffix(n)), mrg_type2='merge', mrg_fracname2='ofrac') + + ! NEMS frac (merge done in fv3) + else if ( fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faii_'//trim(suffix(n)), rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Faii_'//trim(suffix(n)), compatm, mapconsf, 'ifrac', ice2atm_fmap) + call addmrg(fldListTo(compatm)%flds, 'Faii_'//trim(suffix(n)), & + mrg_from1=compice, mrg_fld1='Faii_'//trim(suffix(n)), mrg_type1='merge', mrg_fracname1='ifrac') + + ! CESM (cam, aqua-planet) + else if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm), 'Faxx_'//trim(suffix(n)), rc=rc)) then + call addmap(fldListMed_aoflux%flds , 'Faox_'//trim(suffix(n)), compatm, mapconsf, 'ofrac', ocn2atm_fmap) + call addmrg(fldListTo(compatm)%flds, 'Faxx_'//trim(suffix(n)), & + mrg_from1=compmed, mrg_fld1='Faox_'//trim(suffix(n)), mrg_type1='merge', mrg_fracname1='ofrac') + end if + end if + end do + deallocate(suffix) + + ! --------------------------------------------------------------------- + ! to atm: merged surface temperature and unmerged temperatures from ice and ocn + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Sl_t') + call addfld(fldListFr(compice)%flds, 'Si_t') + call addfld(fldListFr(compocn)%flds, 'So_t') + + call addfld(fldListTo(compatm)%flds, 'So_t') ! cesm, nems-frac + call addfld(fldListTo(compatm)%flds, 'Si_t') ! nems-frac + call addfld(fldListTo(compatm)%flds, 'Sx_t') ! cesm, nems-orig + else + ! CESM - merged ocn/ice/lnd temp and unmerged ocn temp + if (fldchk(is_local%wrap%FBexp(compatm) , 'Sx_t', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_t', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Si_t', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_t', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Sl_t', compatm, mapconsf , 'lfrin', lnd2atm_fmap) + call addmap(fldListFr(compice)%flds, 'Si_t', compatm, mapconsf , 'ifrac', ice2atm_fmap) + call addmap(fldListFr(compocn)%flds, 'So_t', compatm, mapconsf , 'ofrac', ocn2atm_fmap) + call addmrg(fldListTo(compatm)%flds, 'Sx_t', & + mrg_from1=complnd, mrg_fld1='Sl_t', mrg_type1='merge', mrg_fracname1='lfrac', & + mrg_from2=compice, mrg_fld2='Si_t', mrg_type2='merge', mrg_fracname2='ifrac', & + mrg_from3=compocn, mrg_fld3='So_t', mrg_type3='merge', mrg_fracname3='ofrac') + call addmrg(fldListTo(compatm)%flds, 'So_t', & + mrg_from1=compocn, mrg_fld1='So_t', mrg_type1='copy') + + ! NEMS-orig - merged ocn/ice temp and unmerged ocn temp + else if (fldchk(is_local%wrap%FBexp(compatm) , 'Sx_t', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_t', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Si_t', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Si_t', compatm, mapnstod_consf, 'ifrac', ice2atm_fmap) + call addmap(fldListFr(compocn)%flds, 'So_t', compatm, mapnstod_consf, 'none' , ocn2atm_fmap) + call addmrg(fldListTo(compatm)%flds, 'Sx_t', & + mrg_from1=compice, mrg_fld1='Si_t', mrg_type1='merge', mrg_fracname1='ifrac', & + mrg_from2=compocn, mrg_fld2='So_t', mrg_type2='merge', mrg_fracname2='ofrac') + call addmrg(fldListTo(compatm)%flds, 'So_t', & + mrg_from1=compocn, mrg_fld1='So_t', mrg_type1='copy') + + ! CESM aqua-planet - merged and unmerged ocn temp are the same + else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sx_t', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_t', rc=rc)) then + call addmap(fldListFr(compocn)%flds, 'So_t', compatm, mapconsf, 'ofrac', ocn2atm_fmap) + call addmrg(fldListTo(compatm)%flds, 'Sx_t', & + mrg_from1=compocn, mrg_fld1='So_t', mrg_type1='merge', mrg_fracname1='ofrac') + call addmrg(fldListTo(compatm)%flds, 'So_t', & + mrg_from1=compocn, mrg_fld1='So_t', mrg_type1='copy') + end if + + ! NEMS-frac - unmerged ice temp + if ( fldchk(is_local%wrap%FBexp(compatm) , 'Si_t', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Si_t', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Si_t', compatm, mapconsf , 'ifrac', ice2atm_fmap) + call addmrg(fldListTo(compatm)%flds, 'Si_t', & + mrg_from1=compice, mrg_fld1='Si_t', mrg_type1='copy') + end if + end if + + ! --------------------------------------------------------------------- + ! to atm: surface snow depth from ice + ! to atm: mean ice volume per unit area from ice + ! to atm: mean snow volume per unit area from ice + ! --------------------------------------------------------------------- + allocate(flds(3)) + flds = (/'Si_snowh', 'Si_vice', 'Si_vsno'/) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBexp(compatm) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), trim(fldname), rc=rc)) then + if (trim(coupling_mode) == 'nems_orig') then + call addmap(fldListFr(compice)%flds, trim(fldname), compatm, mapnstod_consf, 'ifrac', ice2atm_fmap) + else + call addmap(fldListFr(compice)%flds, trim(fldname), compatm, mapconsf , 'ifrac', ice2atm_fmap) + end if + call addmrg(fldListTo(compatm)%flds, trim(fldname), & + mrg_from1=compice, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(flds) + + ! --------------------------------------------------------------------- + ! to atm: surface saturation specific humidity in ocean from med aoflux + ! to atm: square of exch. coeff (tracers) from med aoflux + ! to atm: surface fraction velocity from med aoflux + ! --------------------------------------------------------------------- + allocate(suffix(3)) + suffix = (/'ssq', 're', 'ustar'/) + + do n = 1,size(suffix) + fldname = 'So_'//trim(suffix(n)) + if (phase == 'advertise') then + call addfld(fldListMed_aoflux%flds , trim(fldname)) + call addfld(fldListTo(compatm)%flds , trim(fldname)) + else + if ( fldchk(is_local%wrap%FBexp(compatm) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , trim(fldname), rc=rc)) then + call addmap(fldListMed_aoflux%flds , trim(fldname), compatm, mapconsf, 'ofrac', ocn2atm_fmap) ! map ocn->atm + call addmrg(fldListTo(compatm)%flds , trim(fldname), & + mrg_from1=compmed, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(suffix) + + ! --------------------------------------------------------------------- + ! to atm: surface fraction velocity from land + ! to atm: aerodynamic resistance from land + ! to atm: surface snow water equivalent from land + ! --------------------------------------------------------------------- + allocate(suffix(3)) + suffix = (/'fv', 'ram1', 'snowh'/) + + do n = 1,size(suffix) + fldname = 'Sl_'//trim(suffix(n)) + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBexp(compatm) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(complnd,complnd ), trim(fldname), rc=rc)) then + call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'lfrin', lnd2atm_fmap) + call addmrg(fldListTo(compatm)%flds, trim(fldname), & + mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(suffix) + + ! --------------------------------------------------------------------- + ! to atm: dust fluxes from land + ! --------------------------------------------------------------------- + allocate(suffix(4)) + suffix = (/'flxdst1', 'flxdst2', 'flxdst3', 'flxdst4'/) + + do n = 1,size(suffix) + fldname = 'Fall_'//trim(suffix(n)) + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then + call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'lfrin', lnd2atm_fmap) + call addmrg(fldListTo(compatm)%flds, trim(fldname), & + mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='copy_with_weights', mrg_fracname1='lfrac') + end if + end if + end do + deallocate(suffix) + + !----------------------------------------------------------------------------- + ! to atm: MEGAN emissions fluxes from land + !----------------------------------------------------------------------------- + if (phase == 'advertise') then + do num = 1, max_megan + write(cnum,'(i3.3)') num + fldname = 'Fall_voc' // cnum + call addfld(fldListFr(complnd)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) + end do + else + do num = 1, max_megan + write(cnum,'(i3.3)') num + fldname = 'Fall_voc' // cnum + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then + call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'one', atm2lnd_fmap) + call addmrg(fldListTo(compatm)%flds, trim(fldname), & + mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='merge', mrg_fracname1='lfrac') + end if + end do + end if + + !----------------------------------------------------------------------------- + ! to atm: fire emissions fluxes from land + !----------------------------------------------------------------------------- + + ! 'wild fire emission fluxes' + if (phase == 'advertise') then + do num = 1, max_fire + write(cnum,'(i2.2)') num + fldname = 'Fall_fire' // cnum + call addfld(fldListFr(complnd)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) + end do + else + do num = 1, max_fire + write(cnum,'(i2.2)') num + fldname = 'Fall_fire' // cnum + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then + call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'one', lnd2atm_fmap) + call addmrg(fldListTo(compatm)%flds, trim(fldname), & + mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='merge', mrg_fracname1='lfrac') + end if + end do + end if + + ! 'wild fire plume height' + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Sl_fztop') + call addfld(fldListTo(compatm)%flds, 'Sl_fztop') + else + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Sl_fztop', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compatm) , 'Sl_fztop', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Sl_fztop', compatm, mapconsf, 'one', lnd2atm_smap) + call addmrg(fldListTo(compatm)%flds, 'Sl_fztop', & + mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + + !----------------------------------------------------------------------------- + ! to atm: dry deposition from land + !----------------------------------------------------------------------------- + if (phase == 'advertise') then + do num = 1, max_ddep + write(cnum,'(i2.2)') num + fldname = 'Sl_dd' // cnum + call addfld(fldListFr(complnd)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) + end do + else + do num = 1, max_ddep + write(cnum,'(i2.2)') num + fldname = 'Sl_dd' // cnum + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then + call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'one', lnd2atm_smap) + call addmrg(fldListTo(compatm)%flds, trim(fldname), & + mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end do + end if + + !===================================================================== + ! FIELDS TO OCEAN (compocn) + !===================================================================== + + !---------------------------------------------------------- + ! to ocn: fractional ice coverage wrt ocean from ice + !---------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds, 'Si_ifrac') + call addfld(fldListTo(compocn)%flds, 'Si_ifrac') + else + call addmap(fldListFr(compice)%flds, 'Si_ifrac', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Si_ifrac', mrg_from1=compice, mrg_fld1='Si_ifrac', mrg_type1='copy') + end if + + ! --------------------------------------------------------------------- + ! to ocn: downward longwave heat flux from atm + ! to ocn: downward direct near-infrared incident solar radiation from atm + ! to ocn: downward diffuse near-infrared incident solar radiation from atm + ! to ocn: downward dirrect visible incident solar radiation from atm + ! to ocn: downward diffuse visible incident solar radiation from atm + ! --------------------------------------------------------------------- + allocate(flds(5)) + flds = (/'Faxa_lwdn', 'Faxa_swndr', 'Faxa_swndf', 'Faxa_swvdr', 'Faxa_swndf'/) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compocn)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBExp(compocn) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, mapconsf, 'one', atm2ocn_fmap) + call addmrg(fldListTo(compocn)%flds, trim(fldname), mrg_from1=compatm, mrg_fld1=trim(fldname), & + mrg_type1='copy_with_weights', mrg_fracname1='ofrac') + end if + end if + end do + deallocate(flds) + + ! --------------------------------------------------------------------- + ! to ocn: surface upward longwave heat flux from mediator + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListMed_aoflux%flds , 'Faox_lwup') + call addfld(fldListTo(compocn)%flds , 'Foxx_lwup') ! cesm, docn + else + if ( fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_lwup', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn), 'Foxx_lwup', rc=rc)) then + call addmrg(fldListTo(compocn)%flds, 'Foxx_lwup', & + mrg_from1=compmed, mrg_fld1='Faox_lwup', mrg_type1='merge', mrg_fracname1='ofrac') + end if + end if + + ! --------------------------------------------------------------------- + ! to ocn: merged longwave net heat flux + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds , 'Faxa_lwdn') + call addfld(fldListFr(compatm)%flds , 'Faxa_lwnet') + call addfld(fldListMed_aoflux%flds , 'Faox_lwup' ) + call addfld(fldListTo(compocn)%flds , 'Foxx_lwnet') + else + ! NEMS-orig (mom6) (send longwave net to ocn via custom merge) + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_lwnet', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_lwup' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwnet', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_lwdn' , compocn, mapconsf, 'one' , atm2ocn_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_lwnet', compocn, mapconsf, 'one' , atm2ocn_fmap) + ! CESM (mom6) (send longwave net to ocn via auto merge) + else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_lwnet', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_lwup' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn' , rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_lwdn', compocn, mapconsf, 'one' , atm2ocn_fmap) + call addmrg(fldListTo(compocn)%flds, 'Foxx_lwnet', & + mrg_from1=compmed, mrg_fld1='Faox_lwup', mrg_type1='merge', mrg_fracname1='ofrac', & + mrg_from2=compatm, mrg_fld2='Faxa_lwdn', mrg_type2='merge', mrg_fracname2='ofrac') + ! NEMS-frac (mom6) (send longwave net to ocean via auto merge) + else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_lwnet', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Foxx_lwnet', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_lwnet', compocn, mapconsf, 'one' , atm2ocn_fmap) + call addmrg(fldListTo(compocn)%flds, 'Foxx_lwnet', & + mrg_from1=compatm, mrg_fld1='Foxx_lwnet', mrg_type1='merge', mrg_fracname1='ofrac') + end if + end if + + ! --------------------------------------------------------------------- + ! to ocn: net shortwave radiation from med + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_swvdr') + call addfld(fldListFr(compatm)%flds, 'Faxa_swndr') + call addfld(fldListFr(compatm)%flds, 'Faxa_swvdf') + call addfld(fldListFr(compatm)%flds, 'Faxa_swndf') + + call addfld(fldListFr(compice)%flds, 'Fioi_swpen') + call addfld(fldListFr(compice)%flds, 'Fioi_swpen_vdr') + call addfld(fldListFr(compice)%flds, 'Fioi_swpen_vdf') + call addfld(fldListFr(compice)%flds, 'Fioi_swpen_idr') + call addfld(fldListFr(compice)%flds, 'Fioi_swpen_idf') + + call addfld(fldListTo(compocn)%flds, 'Foxx_swnet') + call addfld(fldListTo(compocn)%flds, 'Foxx_swnet_vdr') + call addfld(fldListTo(compocn)%flds, 'Foxx_swnet_vdf') + call addfld(fldListTo(compocn)%flds, 'Foxx_swnet_idr') + call addfld(fldListTo(compocn)%flds, 'Foxx_swnet_idf') + else + ! Net shortwave ocean (custom calculation in prep_phases_ocn_mod.F90) + ! export swpent to ocn without bands + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_swnet', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdr', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdf', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndr', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndr', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_swvdr', compocn, mapconsf, 'one', atm2ocn_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_swvdf', compocn, mapconsf, 'one', atm2ocn_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_swndr', compocn, mapconsf, 'one', atm2ocn_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_swndf', compocn, mapconsf, 'one', atm2ocn_fmap) + + ! import swpen from ice without bands + if (fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Fioi_swpen', compocn, mapfcopy, 'unset', 'unset') + end if + end if + + ! export swnet to ocn by bands + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_swnet_vdr', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_swnet_vdf', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_swnet_idr', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_swnet_idf', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdr' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdf' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndr' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndf' , rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_swvdr', compocn, mapconsf, 'one', atm2ocn_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_swvdf', compocn, mapconsf, 'one', atm2ocn_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_swndr', compocn, mapconsf, 'one', atm2ocn_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_swndf', compocn, mapconsf, 'one', atm2ocn_fmap) + + ! import swpen from ice by bands + if ( fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdr', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdf', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_idr', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_idf', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Fioi_swpen_vdr', compocn, mapfcopy, 'unset', 'unset') + call addmap(fldListFr(compice)%flds, 'Fioi_swpen_vdf', compocn, mapfcopy, 'unset', 'unset') + call addmap(fldListFr(compice)%flds, 'Fioi_swpen_idr', compocn, mapfcopy, 'unset', 'unset') + call addmap(fldListFr(compice)%flds, 'Fioi_swpen_idf', compocn, mapfcopy, 'unset', 'unset') + end if + end if + end if + + ! --------------------------------------------------------------------- + ! to ocn: per ice thickness fraction and sw penetrating into ocean from ice + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + if (flds_i2o_per_cat) then + ! 'fractional ice coverage wrt ocean for each thickness category ' + call addfld(fldListFr(compice)%flds, 'Si_ifrac_n') + ! net shortwave radiation penetrating into ocean for each thickness category + call addfld(fldListFr(compice)%flds, 'Fioi_swpen_ifrac_n') + ! 'fractional atmosphere coverage wrt ocean' + call addfld(fldListTo(compocn)%flds, 'Sf_afrac') + ! 'net shortwave radiation times atmosphere fraction' + call addfld(fldListTo(compocn)%flds, 'Foxx_swnet_afracr') + ! 'fractional atmosphere coverage used in radiation computations wrt ocean' + call addfld(fldListTo(compocn)%flds, 'Sf_afracr') + end if + else + if (flds_i2o_per_cat) then + call addmap(fldListFr(compice)%flds, 'Si_ifrac_n', compocn, mapfcopy, 'unset', 'unset') + call addmap(fldListFr(compice)%flds, 'Fioi_swpen_ifrac_n', compocn, mapfcopy, 'unset', 'unset') + ! TODO (mvertens, 2018-12-21): add mapping and merging + end if + end if + + ! --------------------------------------------------------------------- + ! to ocn: precipitation rate water equivalent from atm + ! to ocn: snow rate water equivalent from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + do n = 1,size(iso) + call addfld(fldListFr(compatm)%flds, 'Faxa_rainc'//iso(n)) + call addfld(fldListFr(compatm)%flds, 'Faxa_rainl'//iso(n)) + call addfld(fldListFr(compatm)%flds, 'Faxa_rain' //iso(n)) + call addfld(fldListTo(compocn)%flds, 'Faxa_rain' //iso(n)) + + call addfld(fldListFr(compatm)%flds, 'Faxa_snowc'//iso(n)) + call addfld(fldListFr(compatm)%flds, 'Faxa_snowl'//iso(n)) + call addfld(fldListFr(compatm)%flds, 'Faxa_snow' //iso(n)) + call addfld(fldListTo(compocn)%flds, 'Faxa_snow' //iso(n)) + end do + else + do n = 1,size(iso) + ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization + ! which by default is not actually used + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc'//iso(n), rc=rc) .and. & + (fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain' //iso(n), rc=rc) & + .or. trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'nems_orig')) then + call addmap(fldListFr(compatm)%flds, 'Faxa_rainl'//iso(n), compocn, mapconsf, 'one', atm2ocn_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_rainc'//iso(n), compocn, mapconsf, 'one', atm2ocn_fmap) + if (iso(n) == ' ') then + call addmrg(fldListTo(compocn)%flds, 'Faxa_rain'//iso(n) , & + mrg_from1=compatm, mrg_fld1='Faxa_rainc:Faxa_rainl', & + mrg_type1='sum_with_weights', mrg_fracname1='ofrac') + else + call addmrg(fldListTo(compocn)%flds, 'Faxa_rain'//iso(n) , & + mrg_from1=compatm, mrg_fld1=trim('Faxa_rainc'//iso(n))//':'//trim('Faxa_rainl'//iso(n)), & + mrg_type1='sum_with_weights', mrg_fracname1='ofrac') + end if + else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain'//iso(n), rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_rain'//iso(n), compocn, mapconsf, 'one', atm2ocn_fmap) + call addmrg(fldListTo(compocn)%flds, 'Faxa_rain'//iso(n), mrg_from1=compatm, mrg_fld1='Faxa_rain'//iso(n), & + mrg_type1='copy') + end if + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow' //iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc'//iso(n), rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_snowl'//iso(n), compocn, mapconsf, 'one', atm2ocn_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_snowc'//iso(n), compocn, mapconsf, 'one', atm2ocn_fmap) + if (iso(n) == ' ') then + call addmrg(fldListTo(compocn)%flds, 'Faxa_snow' //iso(n) , & + mrg_from1=compatm, mrg_fld1='Faxa_snowc:Faxa_snowl', & + mrg_type1='sum_with_weights', mrg_fracname1='ofrac') + else + call addmrg(fldListTo(compocn)%flds, 'Faxa_snow' //iso(n) , & + mrg_from1=compatm, mrg_fld1=trim('Faxa_snowc'//iso(n))//':'//trim('Faxa_snowl'//iso(n)), & + mrg_type1='sum_with_weights', mrg_fracname1='ofrac') + end if + else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow'//iso(n), rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_snow'//iso(n), compocn, mapconsf, 'one', atm2ocn_fmap) + call addmrg(fldListTo(compocn)%flds, 'Faxa_snow'//iso(n), mrg_from1=compatm, mrg_fld1='Faxa_snow'//iso(n), & + mrg_type1='copy') + end if + end do + end if + + ! --------------------------------------------------------------------- + ! to ocn: merged sensible heat flux + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds , 'Faxa_sen') + call addfld(fldListMed_aoflux%flds , 'Faox_sen') + call addfld(fldListFr(compice)%flds , 'Fioi_melth') + call addfld(fldListTo(compocn)%flds , 'Foxx_sen') + else + ! NEMS orig + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_sen' , rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_sen' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_melth', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_sen' , rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_sen' , compocn, mapconsf, 'one' , atm2ocn_fmap) ! map atm->ocn + call addmap(fldListFr(compice)%flds, 'Fioi_melth', compocn, mapfcopy, 'unset', 'unset') + + ! NEMS frac + else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_sen', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_sen', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_sen', compocn, mapconsf, 'one' , atm2ocn_fmap) ! map atm->ocn + call addmrg(fldListTo(compocn)%flds, 'Foxx_sen', & + mrg_from1=compatm, mrg_fld1='Faxa_sen' , mrg_type1='merge', mrg_fracname1='ofrac', & + mrg_from2=compice, mrg_fld2='Fioi_melth', mrg_type2='merge', mrg_fracname2='ifrac') + + ! CESM + else if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_sen', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_sen', rc=rc)) then + call addmrg(fldListTo(compocn)%flds, 'Foxx_sen', & + mrg_from1=compmed, mrg_fld1='Faox_sen', mrg_type1='merge', mrg_fracname1='ofrac') + end if + end if + + ! --------------------------------------------------------------------- + ! to ocn: surface latent heat flux and evaporation water flux + ! --------------------------------------------------------------------- + do n = 1,size(iso) + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_lat') + call addfld(fldListMed_aoflux%flds , 'Faox_lat' //iso(n)) + call addfld(fldListMed_aoflux%flds , 'Faox_evap'//iso(n)) + call addfld(fldListTo(compocn)%flds, 'Foxx_lat' //iso(n)) + call addfld(fldListTo(compocn)%flds, 'Foxx_evap'//iso(n)) + else + ! CESM + if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_lat'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_lat'//iso(n), rc=rc)) then + call addmrg(fldListTo(compocn)%flds, 'Foxx_lat'//iso(n), & + mrg_from1=compmed, mrg_fld1='Faox_lat'//iso(n), mrg_type1='merge', mrg_fracname1='ofrac') + end if + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_evap', rc=rc)) then + call addmrg(fldListTo(compocn)%flds, 'Foxx_evap', & + mrg_from1=compmed, mrg_fld1='Faox_evap', mrg_type1='merge', mrg_fracname1='ofrac') + end if + ! NEMS orig + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_evap' , rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_evap' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_lat' , rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_lat', compocn, mapconsf, 'one', atm2ocn_fmap) + end if + + ! NEMS-frac and NEMS-orig + ! Foxx_evap is passed to mom6 but but not the latent heat flux and mom6 then computes + ! the latent heat flux from the imported evaporative flux. However, the evap passed to mom6 + ! in med_phases_prep_ocn is in fact derived from the latent heat flux obtained from the atm (fv3). + ! TODO (mvertens, 2019-10-01): Can we unify this and have MOM6 use latent heat flux? + end if + end do + + ! --------------------------------------------------------------------- + ! to ocn: wind speed squared at 10 meters from med + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListMed_aoflux%flds , 'So_duu10n') + call addfld(fldListTo(compocn)%flds, 'So_duu10n') + else + if ( fldchk(is_local%wrap%FBMed_aoflux_o, 'So_duu10n', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn), 'So_duu10n', rc=rc)) then + + call addmap(fldListMed_aoflux%flds , 'So_duu10n', compatm, mapconsf, 'ofrac', ocn2atm_fmap) ! map ocn->atm + call addmrg(fldListTo(compocn)%flds, 'So_duu10n', & + mrg_from1=compmed, mrg_fld1='So_duu10n', mrg_type1='copy') + end if + end if + + ! --------------------------------------------------------------------- + ! to ocn: sea level pressure from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_pslv') + call addfld(fldListTo(compocn)%flds, 'Sa_pslv') + else + if ( fldchk(is_local%wrap%FBImp(compatm, compatm), 'Sa_pslv', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Sa_pslv', rc=rc)) then + + call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, mapbilnr, 'one', atm2ocn_smap) + call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compice, mapbilnr, 'one', atm2ocn_smap) + + call addmrg(fldListTo(compocn)%flds, 'Sa_pslv', & + mrg_from1=compatm, mrg_fld1='Sa_pslv', mrg_type1='copy') + end if + end if + + ! --------------------------------------------------------------------- + ! to ocn: hydrophylic black carbon dry deposition flux from atm + ! to ocn: hydrophobic black carbon dry deposition flux from atm + ! to ocn: hydrophylic black carbon wet deposition flux from atm + ! to ocn: hydrophylic organic carbon dry deposition flux from atm + ! to ocn: hydrophobic organic carbon dry deposition flux from atm + ! to ocn: hydrophylic organic carbon wet deposition flux to ice from atm + ! to ocn: dust wet deposition flux (size 1) from atm + ! to ocn: dust wet deposition flux (size 2) from atm + ! to ocn: dust wet deposition flux (size 3) from atm + ! to ocn: dust wet deposition flux (size 4) from atm + ! to ocn: dust dry deposition flux (size 1) from atm + ! to ocn: dust dry deposition flux (size 2) from atm + ! to ocn: dust dry deposition flux (size 3) from atm + ! to ocn: dust dry deposition flux (size 4) from atm + ! --------------------------------------------------------------------- + allocate(suffix(14)) + suffix = (/'bcphidry', 'bcphodry', 'bcphiwet', & + 'ocphidry', 'ocphodry', 'ocphiwet', & + 'dstwet1' , 'dstwet2' , 'dstwet3', 'dstwet4', & + 'dstdry1' , 'dstdry2' , 'dstdry3', 'dstdry4' /) + + do n = 1,size(suffix) + fldname = 'Faxa_'//trim(suffix(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compocn)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , trim(fldname), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, mapconsf, 'one', atm2ocn_fmap) + call addmrg(fldListTo(compocn)%flds, trim(fldname), & + mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy_with_weights', mrg_fracname1='ofrac') + end if + end if + end do + deallocate(suffix) + + !----------------------------------------------------------------------------- + ! to ocn: nitrogen deposition fields from atm + !----------------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_noy') + call addfld(fldListFr(compatm)%flds, 'Faxa_nhx') + call addfld(fldListTo(compocn)%flds, 'Faxa_noy') + call addfld(fldListTo(compocn)%flds, 'Faxa_nhx') + else + if ( fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_noy', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_noy', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_noy', compocn, mapbilnr, 'one', atm2ocn_smap) + call addmrg(fldListTo(compocn)%flds, 'Faxa_noy', & + mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy_with_weights', mrg_fracname1='ofrac') + end if + if ( fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_nhx', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_nhx', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_nhx', compocn, mapbilnr, 'one', atm2ocn_smap) + call addmrg(fldListTo(compocn)%flds, 'Faxa_nhx', & + mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy_with_weights', mrg_fracname1='ofrac') + end if + end if + + ! --------------------------------------------------------------------- + ! to ocn: merge zonal surface stress from ice and (atm or med) + ! --------------------------------------------------------------------- + allocate(suffix(2)) + suffix = (/'taux', 'tauy'/) + + do n = 1,size(suffix) + if (phase == 'advertise') then + call addfld(fldListMed_aoflux%flds , 'Faox_'//trim(suffix(n))) + call addfld(fldListFr(compice)%flds , 'Fioi_'//trim(suffix(n))) + call addfld(fldListFr(compatm)%flds , 'Faxa_'//trim(suffix(n))) + call addfld(fldListTo(compocn)%flds , 'Foxx_'//trim(suffix(n))) + else + ! NEMS orig and NEMS frac + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_'//trim(suffix(n)), rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_'//trim(suffix(n)), compocn, mapconsf, 'one' , atm2ocn_fmap) ! map atm->ocn + call addmap(fldListFr(compice)%flds, 'Fioi_'//trim(suffix(n)), compocn, mapfcopy, 'unset', 'unset') + + ! NEMS-frac + call addmrg(fldListTo(compocn)%flds, 'Foxx_'//trim(suffix(n)), & + mrg_from1=compatm, mrg_fld1='Faxa_'//trim(suffix(n)), mrg_type1='merge', mrg_fracname1='ofrac', & + mrg_from2=compice, mrg_fld2='Fioi_'//trim(suffix(n)), mrg_type2='merge', mrg_fracname2='ifrac') + ! NEMS-orig + ! custom merge calculation in med_phases_prep_ocn will be done that will overwrite the auto-merge done above + + ! CESM + else if (fldchk(is_local%wrap%FBexp(compocn), 'Foxx_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_'//trim(suffix(n)), rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Fioi_'//trim(suffix(n)), compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Foxx_'//trim(suffix(n)), & + mrg_from1=compmed, mrg_fld1='Faox_'//trim(suffix(n)), mrg_type1='merge', mrg_fracname1='ofrac', & + mrg_from2=compice, mrg_fld2='Fioi_'//trim(suffix(n)), mrg_type2='merge', mrg_fracname2='ifrac') + end if + end if + end do + deallocate(suffix) + + ! --------------------------------------------------------------------- + ! to ocn: water flux due to melting ice from ice + ! --------------------------------------------------------------------- + do n = 1,size(iso) + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds , 'Fioi_meltw'//iso(n)) + call addfld(fldListTo(compocn)%flds , 'Fioi_meltw'//iso(n)) + else + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Fioi_meltw'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_meltw'//iso(n), rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Fioi_meltw'//iso(n), compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Fioi_meltw'//iso(n), & + mrg_from1=compice, mrg_fld1='Fioi_meltw'//iso(n), mrg_type1='copy_with_weights', mrg_fracname1='ifrac') + end if + end if + end do + + ! --------------------------------------------------------------------- + ! to ocn: heat flux from melting ice from ice + ! to ocn: salt flux from ice + ! to ocn: hydrophylic black carbon deposition flux from ice + ! to ocn: hydrophobic black carbon deposition flux from ice + ! to ocn: dust flux from ice + ! --------------------------------------------------------------------- + ! TODO (mvertens, 2019-01-07): is fioi_melth being handled here? + ! Is fd.yaml correctly aliasing Fioi_melth? + + allocate(flds(5)) + flds = (/'Fioi_melth', 'Fioi_salt', 'Fioi_bcphi', 'Fioi_bcpho', 'Fioi_flxdst'/) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds, trim(fldname)) + call addfld(fldListTo(compocn)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBExp(compocn) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice, compice), trim(fldname), rc=rc)) then + call addmap(fldListFr(compice)%flds, trim(fldname), compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, trim(fldname), & + mrg_from1=compice, mrg_fld1=trim(fldname), mrg_type1='copy_with_weights', mrg_fracname1='ifrac') + end if + end if + end do + deallocate(flds) + + !----------------------------- + ! to ocn: liquid runoff from rof and glc components + ! to ocn: frozen runoff flux from rof and glc components + ! to ocn: waterflux back to ocn due to flooding from rof + !----------------------------- + + if (phase == 'advertise') then + do n = 1,size(iso) + call addfld(fldListFr(compglc)%flds, 'Fogg_rofl'//iso(n)) + call addfld(fldListFr(compglc)%flds, 'Fogg_rofi'//iso(n)) + call addfld(fldListFr(comprof)%flds, 'Forr_rofl'//iso(n)) + call addfld(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n)) + call addfld(fldListTo(compocn)%flds, 'Foxx_rofl'//iso(n)) + call addfld(fldListTo(compocn)%flds, 'Foxx_rofi'//iso(n)) + end do + else + do n = 1,size(iso) + ! from both rof and glc to con + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofl'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compglc, compglc), 'Fogg_rofl'//iso(n), rc=rc)) then + call addmap(fldListFr(comprof)%flds, 'Forr_rofl'//iso(n), compocn, mapconsf, 'none', rof2ocn_liq_rmap) + call addmap(fldListFr(compglc)%flds, 'Fogg_rofl'//iso(n), compocn, mapconsf, 'one' , glc2ocn_liq_rmap) + call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl'//iso(n), & + mrg_from1=comprof, mrg_fld1='Forr_rofl:Flrr_flood', mrg_type1='sum', & + mrg_from2=compglc, mrg_fld2='Fogg_rofl'//iso(n) , mrg_type2='sum') + + ! liquid runoff from rof and flood to ocn + else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofl' //iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl' //iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood'//iso(n), rc=rc)) then + call addmap(fldListFr(comprof)%flds, 'Flrr_flood'//iso(n), compocn, mapfiler, 'none', rof2ocn_fmap) + call addmap(fldListFr(comprof)%flds, 'Forr_rofl' //iso(n), compocn, mapfiler, 'none', rof2ocn_liq_rmap) + call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl' //iso(n), & + mrg_from1=comprof, mrg_fld1='Forr_rofl:Flrr_flood', mrg_type1='sum') + + ! liquid from just rof to ocn + else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofl'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl'//iso(n), rc=rc)) then + call addmap(fldListFr(comprof)%flds, 'Forr_rofl'//iso(n), compocn, mapconsf, 'none', rof2ocn_liq_rmap) + call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl'//iso(n), & + mrg_from1=comprof, mrg_fld1='Forr_rofl:Flrr_flood', mrg_type1='sum') + + ! liquid runoff from just glc to ocn + else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofl'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compglc, compglc), 'Fogg_rofl'//iso(n), rc=rc)) then + call addmap(fldListFr(compglc)%flds, 'Fogg_rofl'//iso(n), compocn, mapconsf, 'one', glc2ocn_liq_rmap) + call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl'//iso(n), & + mrg_from1=compglc, mrg_fld1='Fogg_rofl'//iso(n), mrg_type1='copy') + end if + + ! ice runoff from both rof and glc to ocn + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofi'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compglc, compglc), 'Fogg_rofi'//iso(n), rc=rc)) then + call addmap(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n), compocn, mapconsf, 'none', rof2ocn_ice_rmap) + call addmap(fldListFr(compglc)%flds, 'Fogg_rofi'//iso(n), compocn, mapconsf, 'one' , glc2ocn_ice_rmap) + call addmrg(fldListTo(compocn)%flds, 'Foxx_rofi'//iso(n), & + mrg_from1=comprof, mrg_fld1='Forr_rofi'//iso(n), mrg_type1='sum', & + mrg_from2=compglc, mrg_fld2='Fogg_rofi'//iso(n), mrg_type2='sum') + + ! ice runoff from just rof to ocn + else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofi'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi'//iso(n), rc=rc)) then + call addmap(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n), compocn, mapconsf, 'none', rof2ocn_ice_rmap) + call addmrg(fldListTo(compocn)%flds, 'Foxx_rofi'//iso(n), & + mrg_from1=comprof, mrg_fld1='Forr_rofi', mrg_type1='copy') + + ! ice runoff from just glc to ocn + else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofi'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compglc, compglc), 'Fogg_rofi'//iso(n), rc=rc)) then + call addmap(fldListFr(compglc)%flds, 'Fogg_rofi'//iso(n), compocn, mapconsf, 'one', glc2ocn_ice_rmap) + call addmrg(fldListTo(compocn)%flds, 'Foxx_rofi'//iso(n), & + mrg_from1=compglc, mrg_fld1='Fogg_rofi'//iso(n), mrg_type1='copy') + end if + end do + end if + + !----------------------------- + ! to ocn: Langmuir multiplier from wave + ! to ocn: Stokes drift u component from wave + ! to ocn: Stokes drift v component from wave + ! to ocn: Stokes drift depth from wave + !----------------------------- + allocate(flds(4)) + flds = (/'Sw_lamult', 'Sw_ustokes', 'Sw_vstokes', 'Sw_hstokes'/) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compwav)%flds, trim(fldname)) + call addfld(fldListTo(compocn)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBExp(compocn) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), trim(fldname), rc=rc)) then + call addmap(fldListFr(compwav)%flds, trim(fldname), compocn, mapbilnr, 'one', wav2ocn_smap) + call addmrg(fldListTo(compocn)%flds, trim(fldname), & + mrg_from1=compwav, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(flds) + + + !===================================================================== + ! FIELDS TO ICE (compice) + !===================================================================== + + ! --------------------------------------------------------------------- + ! to ice: downward longwave heat flux from atm + ! to ice: downward direct near-infrared incident solar radiation from atm + ! to ice: downward direct visible incident solar radiation from atm + ! to ice: downward diffuse near-infrared incident solar radiation from atm + ! to ice: downward Diffuse visible incident solar radiation from atm + ! to ice: hydrophylic black carbon dry deposition flux from atm + ! to ice: hydrophobic black carbon dry deposition flux from atm + ! to ice: hydrophylic black carbon wet deposition flux from atm + ! to ice: hydrophylic organic carbon dry deposition flux from atm + ! to ice: hydrophobic organic carbon dry deposition flux from atm + ! to ice: hydrophylic organic carbon wet deposition flux from atm + ! to ice: dust wet deposition flux (size 1) from atm + ! to ice: dust wet deposition flux (size 2) from atm + ! to ice: dust wet deposition flux (size 3) from atm + ! to ice: dust wet deposition flux (size 4) from atm + ! to ice: dust dry deposition flux (size 1) from atm + ! to ice: dust dry deposition flux (size 2) from atm + ! to ice: dust dry deposition flux (size 3) from atm + ! to ice: dust dry deposition flux (size 4) from atm + ! --------------------------------------------------------------------- + allocate(flds(19)) + flds = (/'Faxa_lwdn' , 'Faxa_swndr' , 'Faxa_swvdr' , 'Faxa_swndf' , 'Faxa_swvdf', & + 'Faxa_bcphidry', 'Faxa_bcphodry', 'Faxa_bcphiwet', & + 'Faxa_ocphidry', 'Faxa_ocphodry', 'Faxa_ocphiwet', & + 'Faxa_dstwet1' , 'Faxa_dstwet2' , 'Faxa_dstwet3' , 'Faxa_dstwet4', & + 'Faxa_dstdry1' , 'Faxa_dstdry2' , 'Faxa_dstdry3' , 'Faxa_dstdry4'/) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compice)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBExp(compice) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapconsf, 'one', atm2ice_fmap) + call addmrg(fldListTo(compice)%flds, trim(fldname), & + mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(flds) + + ! --------------------------------------------------------------------- + ! to ice: convective and large scale precipitation rate water equivalent from atm + ! to ice: rain and snow rate from atm + ! --------------------------------------------------------------------- + do n = 1,size(iso) + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_rainc'//iso(n)) + call addfld(fldListFr(compatm)%flds, 'Faxa_rainl'//iso(n)) + call addfld(fldListFr(compatm)%flds, 'Faxa_rain' //iso(n)) + call addfld(fldListTo(compice)%flds, 'Faxa_rain' //iso(n)) + + call addfld(fldListFr(compatm)%flds, 'Faxa_snowc'//iso(n)) + call addfld(fldListFr(compatm)%flds, 'Faxa_snowl'//iso(n)) + call addfld(fldListFr(compatm)%flds, 'Faxa_snow' //iso(n)) + call addfld(fldListTo(compice)%flds, 'Faxa_snow' //iso(n)) + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain' //iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc'//iso(n), rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_rainc'//iso(n), compice, mapconsf, 'one', atm2ice_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_rainl'//iso(n), compice, mapconsf, 'one', atm2ice_fmap) + if (iso(n) == ' ') then + fldname = 'Faxa_rainc:Faxa_rainl' + else + fldname = trim('Faxa_rainc'//iso(n))//':'//trim('Faxa_rainl'//iso(n)) + end if + call addmrg(fldListTo(compice)%flds, 'Faxa_rain' //iso(n) , & + mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='sum') + else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain'//iso(n), rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_rain'//iso(n), compice, mapconsf, 'one', atm2ice_fmap) + call addmrg(fldListTo(compice)%flds, 'Faxa_rain'//iso(n), & + mrg_from1=compatm, mrg_fld1='Faxa_rain'//iso(n), mrg_type1='copy') + end if + + if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow' //iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc'//iso(n), rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_snowc'//iso(n), compice, mapconsf, 'one', atm2ice_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_snowl'//iso(n), compice, mapconsf, 'one', atm2ice_fmap) + if (iso(n) == ' ') then + fldname = 'Faxa_snowc:Faxa_snowl' + else + fldname = trim('Faxa_snowc'//iso(n))//':'//trim('Faxa_snowl'//iso(n)) + end if + call addmrg(fldListTo(compice)%flds, 'Faxa_snow' //iso(n) , & + mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='sum') + else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow'//iso(n), rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_snow'//iso(n), compice, mapconsf, 'one', atm2ice_fmap) + call addmrg(fldListTo(compice)%flds, 'Faxa_snow'//iso(n), & + mrg_from1=compatm, mrg_fld1='Faxa_snow'//iso(n), mrg_type1='copy') + end if + end if + end do + + ! --------------------------------------------------------------------- + ! to ice: height at the lowest model level from atm + ! to ice: pressure at the lowest model level fromatm + ! to ice: temperature at the lowest model level from atm + ! to ice: potential temperature at the lowest model level from atm + ! to ice: density at the lowest model level from atm + ! to ice: zonal wind at the lowest model level from atm + ! to ice: meridional wind at the lowest model level from atm + ! to ice: specific humidity at the lowest model level from atm + ! to ice: specific humidity for water isotopes at the lowest model level from atm + ! --------------------------------------------------------------------- + allocate(flds(11)) + flds = (/'Sa_z', 'Sa_pbot', 'Sa_tbot', 'Sa_ptem', 'Sa_dens', 'Sa_u', 'Sa_v', & + 'Sa_shum', 'Sa_shum_16O', 'Sa_shum_18O', 'Sa_shum_HDO'/) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compice)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBexp(compice) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), trim(fldname), rc=rc)) then + if (trim(fldname) == 'Sa_u' .or. trim(fldname) == 'Sa_v') then + call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mappatch, 'one', atm2ice_vmap) + else + call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapbilnr, 'one', atm2ice_smap) + end if + call addmrg(fldListTo(compice)%flds, trim(fldname), & + mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(flds) + + ! --------------------------------------------------------------------- + ! to ice: sea surface temperature from ocn + ! to ice: sea surface salinity from ocn + ! to ice: zonal sea water velocity from ocn + ! to ice: meridional sea water velocity from ocn + ! to ice: zonal sea surface slope from ocean + ! to ice: meridional sea surface slope from ocn + ! --------------------------------------------------------------------- + allocate(flds(6)) + flds = (/'So_t', 'So_s', 'So_u', 'So_v', 'So_dhdx', 'So_dhdy'/) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, trim(fldname)) + call addfld(fldListTo(compice)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBexp(compice) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), trim(fldname), rc=rc)) then + call addmap(fldListFr(compocn)%flds, trim(fldname), compice, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compice)%flds, trim(fldname), & + mrg_from1=compocn, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(flds) + + ! --------------------------------------------------------------------- + ! to ice: ocean melt and freeze potential from ocn + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, 'Fioo_q') + call addfld(fldListTo(compice)%flds, 'Fioo_q') + else + if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'Fioo_q', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compice) , 'Fioo_q', rc=rc)) then + call addmap(fldListFr(compocn)%flds, 'Fioo_q', compice, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compice)%flds, 'Fioo_q', mrg_from1=compocn, mrg_fld1='Fioo_q', mrg_type1='copy') + end if + end if + + ! --------------------------------------------------------------------- + ! to ice: frozen runoff from rof and glc + ! --------------------------------------------------------------------- + do n = 1,size(iso) + if (phase == 'advertise') then + call addfld(fldListFr(comprof)%flds, 'Firr_rofi'//iso(n)) ! water flux into sea ice due to runoff (frozen) + call addfld(fldListFr(compglc)%flds, 'Figg_rofi'//iso(n)) ! glc frozen runoff_iceberg flux to ice + call addfld(fldListTo(compice)%flds, 'Fixx_rofi'//iso(n)) ! total frozen water flux into sea ice + else + if ( fldchk(is_local%wrap%FBExp(compice) , 'Fixx_rofi'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compglc, compglc), 'Figg_rofi'//iso(n), rc=rc)) then + + call addmap(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n), compice, mapconsf, 'none', rof2ocn_ice_rmap) + call addmap(fldListFr(compglc)%flds, 'Figg_rofi'//iso(n), compice, mapconsf, 'one' , glc2ice_rmap) + call addmrg(fldListTo(compice)%flds, 'Fixx_rofi'//iso(n), & + mrg_from1=comprof, mrg_fld1='Firr_rofi'//iso(n), mrg_type1='sum', & + mrg_from2=compglc, mrg_fld2='Figg_rofi'//iso(n), mrg_type2='sum') + + else if ( fldchk(is_local%wrap%FBExp(compice) , 'Fixx_rofi'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi'//iso(n), rc=rc)) then + + call addmap(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n), compice, mapconsf, 'none', rof2ocn_ice_rmap) + call addmrg(fldListTo(compice)%flds, 'Fixx_rofi'//iso(n), & + mrg_from1=comprof, mrg_fld1='Firr_rofi'//iso(n), mrg_type1='sum') + end if + end if + end do + + !===================================================================== + ! FIELDS TO WAVE (compwav) + !===================================================================== + + !---------------------------------------------------------- + ! to wav: fractional ice coverage wrt ocean from ice + !---------------------------------------------------------- + if (phase == 'advertise') then + ! the following is computed in med_phases_prep_wav + call addfld(fldListFr(compice)%flds, 'Si_ifrac') + call addfld(fldListTo(compwav)%flds, 'Si_ifrac') + end if + + ! --------------------------------------------------------------------- + ! to wav: ocean boundary layer depth from ocn + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, 'So_bldepth') + call addfld(fldListTo(compwav)%flds, 'So_bldepth') + else + if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_bldepth', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compwav) , 'So_bldepth', rc=rc)) then + call addmap(fldListFr(compocn)%flds, 'So_bldepth', compwav, mapbilnr, 'one', ocn2wav_smap) + call addmrg(fldListTo(compwav)%flds, 'So_bldepth', mrg_from1=compocn, mrg_fld1='So_bldepth', mrg_type1='copy') + end if + end if + + ! --------------------------------------------------------------------- + ! to wav: zonal wind at the lowest model level from atm + ! to wav: meridional wind at the lowest model level from atm + ! --------------------------------------------------------------------- + allocate(flds(2)) + flds = (/'Sa_u', 'Sa_v'/) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compwav)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBexp(compwav) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), trim(fldname), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(fldname), compwav, mapbilnr, 'one', atm2wav_smap) + call addmrg(fldListTo(compwav)%flds, trim(fldname), & + mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(flds) + + !===================================================================== + ! FIELDS TO RIVER (comprof) + !===================================================================== + + ! --------------------------------------------------------------------- + ! to rof: water flux from land (liquid surface) + ! to rof: water flux from land (liquid glacier, wetland, and lake) + ! to rof: water flux from land (liquid subsurface) + ! to rof: water flux from land direct to ocean + ! to rof: irrigation flux from land (withdrawal from rivers) + ! --------------------------------------------------------------------- + ! TODO (mvertens, 2019-01-13): the following isotopes have not yet been defined in the NUOPC field dict + ! allocate(flds(30)) + ! flds = (/'Flrl_rofsur', 'Flrl_rofsur_16O', 'Flrl_rofsur_18O', 'Flrl_rofsur_HDO', & + ! 'Flrl_rofgwl', 'Flrl_rofgwl_16O', 'Flrl_rofgwl_18O', 'Flrl_rofgwl_HDO', & + ! 'Flrl_rofsub', 'Flrl_rofsub_16O', 'Flrl_rofsub_18O', 'Flrl_rofsub_HDO', & + ! 'Flrl_rofdto', 'Flrl_rofdto_16O', 'Flrl_rofdto_18O', 'Flrl_rofdto_HDO', & + ! 'Flrl_rofi' , 'Flrl_rofi_16O' , 'Flrl_rofi_18O' , 'Flrl_rofi_HDO' , & + ! 'Flrl_irrig' , 'Flrl_irrig_16O' , 'Flrl_irrig_18O' , 'Flrl_irrig_HDO' /) + + allocate(flds(6)) + flds = (/'Flrl_rofsur', 'Flrl_rofgwl', 'Flrl_rofsub', 'Flrl_rofdto', 'Flrl_rofi', 'Flrl_irrig'/) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, trim(fldname)) + call addfld(fldListTo(comprof)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(comprof) , trim(fldname), rc=rc)) then + call addmap(fldListFr(complnd)%flds, trim(fldname), comprof, mapconsd, 'lfrin', lnd2rof_fmap) + call addmrg(fldListTo(comprof)%flds, trim(fldname), & + mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='copy_with_weights', mrg_fracname1='lfrac') + end if + end if + end do + deallocate(flds) + + !===================================================================== + ! FIELDS TO LAND-ICE (compglc) + !===================================================================== + + !----------------------------- + ! to glc: from land + !----------------------------- + + ! - fields sent from lnd->med ARE in multiple elevation classes + ! - fields sent from med->glc do NOT have elevation classes + + ! Sets a coupling field for all glc elevation classes (1:glc_nec) plus bare land (index 0). + ! Note that, if glc_nec = 0, then we don't create any coupling fields (not even the bare land (0) fldindex) + ! Note : Sl_topo is sent from lnd -> med, but is NOT sent to glc (only used for the remapping in the mediator) + + if (glc_nec > 0) then + if (phase == 'advertise') then + do num = 0, glc_nec + cnum = glc_elevclass_as_string(num) + call addfld(fldListFr(complnd)%flds, 'Flgl_qice'//trim(cnum)) ! glacier ice flux' + call addfld(fldListFr(complnd)%flds, 'Sl_tsrf' //trim(cnum)) ! surface temperature of glacier' + call addfld(fldListFr(complnd)%flds, 'Sl_topo' //trim(cnum)) ! surface height of glacier + end do + call addfld(fldListTo(compglc)%flds, 'Flgl_qice') + call addfld(fldListTo(compglc)%flds, 'Sl_tsrf') + call addfld(fldListTo(compglc)%flds, 'Sl_topo') + else + if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flgl_qice'//trim(cnum), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(complnd) , 'Sl_tsrf'//trim(cnum) , rc=rc) .and. & + fldchk(is_local%wrap%FBExp(complnd) , 'Sl_topo'//trim(cnum) , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Sg_ice_covered' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Sg_topo' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Flgg_hflx' , rc=rc)) then + + do num = 0, glc_nec + cnum = glc_elevclass_as_string(num) + call addmap(FldListFr(complnd)%flds, 'Flgl_qice'//trim(cnum), compglc, mapconsf, 'none', lnd2glc_fmap) + call addmap(FldListFr(complnd)%flds, 'Sl_tsrf'//trim(cnum) , compglc, mapbilnr, 'none', lnd2glc_smap) + call addmap(FldListFr(complnd)%flds, 'Sl_topo'//trim(cnum) , compglc, mapbilnr, 'none', lnd2glc_smap) + end do + end if + end if + end if + + !===================================================================== + ! CO2 EXCHANGE + !===================================================================== + + 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, rc=dbrc) + + 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, rc=dbrc) + + 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, rc=dbrc) + + if (flds_co2a) then + ! --------------------------------------------------------------------- + ! to lnd and ocn: prognostic CO2 at the lowest atm model level + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_co2prog') + call addfld(fldListTo(complnd)%flds, 'Sa_co2prog') + call addfld(fldListTo(compocn)%flds, 'Sa_co2prog') + else + call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_smap) + call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_smap) + + call addmrg(fldListTo(complnd)%flds, 'Sa_co2prog', & + mrg_from1=compatm, mrg_fld1='Sa_co2prog', mrg_type1='copy') + call addmrg(fldListTo(compocn)%flds, 'Sa_co2prog', & + mrg_from1=compatm, mrg_fld1='Sa_co2prog', mrg_type1='copy') + end if + + ! --------------------------------------------------------------------- + ! to lnd and ocn: diagnostic CO2 at the lowest atm model level + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_co2diag') + call addfld(fldListTo(complnd)%flds, 'Sa_co2diag') + call addfld(fldListTo(compocn)%flds, 'Sa_co2diag') + else + call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_smap) + call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_smap) + + call addmrg(fldListTo(complnd)%flds, 'Sa_co2diag', & + mrg_from1=compatm, mrg_fld1='Sa_co2diag', mrg_type1='copy') + call addmrg(fldListTo(compocn)%flds, 'Sa_co2diag', & + mrg_from1=compatm, mrg_fld1='Sa_co2diag', mrg_type1='copy') + end if + + else if (flds_co2b) then + + ! --------------------------------------------------------------------- + ! to lnd: prognostic CO2 at the lowest atm model level + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_co2prog') + call addfld(fldListTo(complnd)%flds, 'Sa_co2prog') + else + call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_smap) + call addmrg(fldListTo(complnd)%flds, 'Sa_co2prog', & + mrg_from1=compatm, mrg_fld1='Sa_co2prog', mrg_type1='copy') + end if + + ! --------------------------------------------------------------------- + ! to lnd: diagnostic CO2 at the lowest atm model level + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_co2diag') + call addfld(fldListTo(complnd)%flds, 'Sa_co2diag') + else + call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_smap) + call addmrg(fldListTo(complnd)%flds, 'Sa_co2diag', & + mrg_from1=compatm, mrg_fld1='Sa_co2diag', mrg_type1='copy') + end if + + ! --------------------------------------------------------------------- + ! to atm: surface flux of CO2 from land + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Fall_fco2_lnd') + call addfld(fldListTo(compatm)%flds, 'Fall_fco2_lnd') + else + call addmap(fldListFr(complnd)%flds, 'Fall_fco2_lnd', compatm, mapconsf, 'one', atm2lnd_smap) + call addmrg(fldListTo(compatm)%flds, 'Fall_fco2_lnd', & + mrg_from1=complnd, mrg_fld1='Fall_fco2_lnd', mrg_type1='copy_with_weights', mrg_fracname1='lfrac') + end if + + else if (flds_co2c) then + + ! --------------------------------------------------------------------- + ! to lnd and ocn: prognostic CO2 at the lowest atm model level + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_co2prog') + call addfld(fldListTo(complnd)%flds, 'Sa_co2prog') + call addfld(fldListTo(compocn)%flds, 'Sa_co2prog') + else + call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_smap) + call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_smap) + + call addmrg(fldListTo(complnd)%flds, 'Sa_co2prog', & + mrg_from1=compatm, mrg_fld1='Sa_co2prog', mrg_type1='copy') + call addmrg(fldListTo(compocn)%flds, 'Sa_co2prog', & + mrg_from1=compatm, mrg_fld1='Sa_co2prog', mrg_type1='copy') + end if + + ! --------------------------------------------------------------------- + ! to lnd and ocn: diagnostic CO2 at the lowest atm model level + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_co2diag') + call addfld(fldListTo(complnd)%flds, 'Sa_co2diag') + call addfld(fldListTo(compocn)%flds, 'Sa_co2diag') + else + call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_smap) + call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_smap) + + call addmrg(fldListTo(complnd)%flds, 'Sa_co2diag', & + mrg_from1=compatm, mrg_fld1='Sa_co2diag', mrg_type1='copy') + call addmrg(fldListTo(compocn)%flds, 'Sa_co2diag', & + mrg_from1=compatm, mrg_fld1='Sa_co2diag', mrg_type1='copy') + end if + + ! --------------------------------------------------------------------- + ! to atm: surface flux of CO2 from land + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Fall_fco2_lnd') + call addfld(fldListTo(compatm)%flds, 'Fall_fco2_lnd') + else + call addmap(fldListFr(complnd)%flds, 'Fall_fco2_lnd', compatm, mapconsf, 'one', atm2lnd_smap) + call addmrg(fldListTo(compatm)%flds, 'Fall_fco2_lnd', & + mrg_from1=complnd, mrg_fld1='Fall_fco2_lnd', mrg_type1='copy_with_weights', mrg_fracname1='lfrac') + end if + + ! --------------------------------------------------------------------- + ! to atm: surface flux of CO2 from ocn + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, 'Faoo_fco2_ocn') + call addfld(fldListTo(compatm)%flds, 'Faoo_fco2_ocn') + else + call addmap(fldListFr(complnd)%flds, 'Faoo_fco2_ocn', compatm, mapconsf, 'one', atm2lnd_smap) + ! custom merge in med_phases_prep_atm + end if + endif + + !----------------------------- + ! water isotope fields - TODO: add these to dictionary first + !----------------------------- + ! 'Ratio of ocean surface level abund. H2_16O/H2O/Rstd' + ! call fld_add(flds_o2x, "So_roce_16O") + ! call fld_add(flds_x2i, "So_roce_16O") + ! 'Ratio of ocean surface level abund. HDO/H2O/Rstd' + ! call fld_add(flds_o2x, "So_roce_HDO") + ! call fld_add(flds_x2i, "So_roce_HDO") + + !----------------------------------------------------------------------------- + ! CARMA fields (volumetric soil water) + !----------------------------------------------------------------------------- + ! TODO: add this + ! if (carma_flds /= ' ') then + ! do n = 1,shr_string_listGetNum(carma_flds) + ! call addfld(fldListFr(complnd)%flds, trim(fldname)) + ! call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'one',lnd2atm_smap) + ! call addfld(fldListTo(compatm)%flds, trim(fldname), mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='copy') + ! enddo + ! endif + + end subroutine esmFldsExchange + +end module esmFldsExchange_mod diff --git a/src/exch_flds/fd.yaml b/src/exch_flds/fd.yaml new file mode 100644 index 00000000..c6a3895a --- /dev/null +++ b/src/exch_flds/fd.yaml @@ -0,0 +1,2468 @@ + field_dictionary: + version_number: 0.0.0 + institution: National ESPC, CSC & MCL Working Groups + source: automatically generated by the NUOPC Layer + description: Community-based dictionary for shared coupling fields + entries: + # + #----------------------------------- + # section: mediator export for atm/ocn flux calculation + #----------------------------------- + # + - standard_name: Faox_evap + alias: mean_evap_rate_atm_into_ocn + canonical_units: kg m-2 s-1 + description: mediator export + atm/ocn evaporation water flux + # + - standard_name: Faox_lat + alias: mean_laten_heat_flx_atm_into_ocn + canonical_units: W m-2 + description: mediator export + atm/ocn surface latent heat flux + # + - standard_name: Faox_sen + alias: mean_sensi_heat_flx_atm_into_ocn + canonical_units: W m-2 + description: mediator export + atm/ocn surface sensible heat flux + # + - standard_name: Faox_lwup + alias: mean_up_lw_flx_ocn + canonical_units: W m-2 + description: mediator export + long wave radiation flux over the ocean + # + - standard_name: Faox_taux + alias: stress_on_air_ocn_zonal + canonical_units: N m-2 + description: mediator export + # + - standard_name: Faox_tauy + alias: stress_on_air_ocn_merid + canonical_units: N m-2 + description: mediator export + # + - standard_name: Faox_evap_16O + canonical_units: kg m-2 s-1 + description: mediator export + atm/ocn evaporation water flux 16O + # + - standard_name: Faox_evap_18O + canonical_units: kg m-2 s-1 + description: mediator export + atm/ocn evaporation water flux 18O + # + - standard_name: Faox_evap_HDO + canonical_units: kg m-2 s-1 + description: mediator export + atm/ocn evaporation water flux HDO + # + #----------------------------------- + # section: land export + #----------------------------------- + # + - standard_name: Fall_evap + canonical_units: kg m-2 s-1 + description: land export + # + - standard_name: Fall_evap_16O + canonical_units: kg m-2 s-1 + # + - standard_name: Fall_evap_18O + canonical_units: kg m-2 s-1 + description: land export + # + - standard_name: Fall_evap_HDO + canonical_units: kg m-2 s-1 + description: land export + # + - standard_name: Fall_fco2_lnd + canonical_units: moles m-2 s-1 + description: land export + # + - standard_name: Fall_fire01 + canonical_units: kg/m2/sec + description: land export + wild fire emission fluxes1 + # + - standard_name: Fall_fire02 + canonical_units: kg/m2/sec + description: land export + wild fire emission fluxes2 + # + - standard_name: Fall_fire03 + canonical_units: kg/m2/sec + description: land export + wild fire emission fluxes3 + # + - standard_name: Fall_fire04 + canonical_units: kg/m2/sec + description: land export + wild fire emission fluxes4 + # + - standard_name: Fall_fire05 + canonical_units: kg/m2/sec + description: land export + wild fire emission fluxes5 + # + - standard_name: Fall_fire06 + canonical_units: kg/m2/sec + description: land export + wild fire emission fluxes6 + # + - standard_name: Fall_fire07 + canonical_units: kg/m2/sec + description: land export + wild fire emission fluxes7 + # + - standard_name: Fall_fire08 + canonical_units: kg/m2/sec + description: land export + wild fire emission fluxes8 + # + - standard_name: Fall_fire09 + canonical_units: kg/m2/sec + description: land export + wild fire emission fluxes9 + # + - standard_name: Fall_fire10 + canonical_units: kg/m2/sec + description: land export + wild fire emission fluxes10 + # + - standard_name: Fall_flxdst1 + canonical_units: kg m-2 s-1 + description: land export + # + - standard_name: Fall_flxdst2 + canonical_units: kg m-2 s-1 + description: land export + # + - standard_name: Fall_flxdst3 + canonical_units: kg m-2 s-1 + description: land export + # + - standard_name: Fall_flxdst4 + canonical_units: kg m-2 s-1 + description: land export + # + - standard_name: Fall_lat + canonical_units: W m-2 + description: land export + # + - standard_name: Fall_lwup + canonical_units: W m-2 + description: land export + # + - standard_name: Fall_sen + canonical_units: W m-2 + description: land export + # + - standard_name: Fall_swnet + canonical_units: W m-2 + description: land export + # + - standard_name: Fall_taux + canonical_units: N m-2 + description: land export + # + - standard_name: Fall_tauy + canonical_units: N m-2 + description: land export + # + - standard_name: Fall_voc001 + canonical_units: molecules/m2/sec + description: land export + # + - standard_name: Fall_voc002 + canonical_units: molecules/m2/sec + description: land export + # + - standard_name: Fall_voc003 + canonical_units: molecules/m2/sec + description: land export + # + - standard_name: Fall_voc004 + canonical_units: molecules/m2/sec + description: land export + # + - standard_name: Fall_voc005 + canonical_units: molecules/m2/sec + description: land export + # + - standard_name: Fall_voc006 + canonical_units: molecules/m2/sec + description: land export + # + - standard_name: Fall_voc007 + canonical_units: molecules/m2/sec + description: land export + # + - standard_name: Fall_voc008 + canonical_units: molecules/m2/sec + description: land export + # + - standard_name: Fall_voc009 + canonical_units: molecules/m2/sec + description: land export + # + - standard_name: Fall_voc010 + canonical_units: molecules/m2/sec + description: land export + # + - standard_name: Fall_voc011 + canonical_units: molecules/m2/sec + description: land export + # + - standard_name: Fall_voc012 + canonical_units: molecules/m2/sec + description: land export + # + - standard_name: Fall_voc013 + canonical_units: molecules/m2/sec + description: land export + # + - standard_name: Fall_voc014 + canonical_units: molecules/m2/sec + description: land export + # + - standard_name: Fall_voc015 + canonical_units: molecules/m2/sec + description: land export + # + - standard_name: Fall_voc016 + canonical_units: molecules/m2/sec + description: land export + # + - standard_name: Fall_voc017 + canonical_units: molecules/m2/sec + description: land export + # + - standard_name: Fall_voc018 + canonical_units: molecules/m2/sec + description: land export + # + - standard_name: Fall_voc019 + canonical_units: molecules/m2/sec + description: land export + # + - standard_name: Fall_voc020 + canonical_units: molecules/m2/sec + description: land export + # + - standard_name: Sl_anidf + canonical_units: 1 + description: land export + # + - standard_name: Sl_anidr + canonical_units: 1 + description: land export + # + - standard_name: Sl_avsdf + canonical_units: 1 + description: land export + # + - standard_name: Sl_avsdr + canonical_units: 1 + description: land export + # + - standard_name: Sl_dd01 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd02 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd03 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd04 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd05 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd06 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd07 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd08 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd09 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd10 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd11 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd12 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd13 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd14 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd15 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd16 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd17 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd18 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd19 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd20 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd21 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd22 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd23 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd24 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd25 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd26 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd27 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd28 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd29 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd30 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd31 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd32 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd33 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd34 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd35 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd36 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd37 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd38 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd39 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd40 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd41 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd42 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd43 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd44 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd45 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd46 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd47 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd48 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd49 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd50 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd51 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd52 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd53 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd54 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd55 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd56 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd57 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd58 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd59 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd60 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd61 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd62 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd63 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd64 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd65 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd66 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd67 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd68 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd69 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd70 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd71 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd72 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd73 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd74 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd75 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd76 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd77 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd78 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd79 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_dd80 + canonical_units: cm/sec + description: land export + # + - standard_name: Sl_fv + canonical_units: m s-1 + description: land export + # + - standard_name: Sl_fztop + canonical_units: m + description: land export + # + - standard_name: Sl_lfrac + alias: land_mask + canonical_units: 1 + description: land export + # + - standard_name: Sl_lfrin + canonical_units: 1 + description: land export + # + - standard_name: Sl_qref + canonical_units: kg kg-1 + description: land export + # + - standard_name: Sl_qref_16O + canonical_units: kg kg-1 + description: land export + # + - standard_name: Sl_qref_18O + canonical_units: kg kg-1 + description: land export + # + - standard_name: Sl_qref_HDO + canonical_units: kg kg-1 + description: land export + # + - standard_name: Sl_ram1 + canonical_units: s/m + description: land export + # + - standard_name: Sl_snowh + canonical_units: m + description: land export + # + - standard_name: Sl_snowh_16O + canonical_units: m + description: land export + # + - standard_name: Sl_snowh_18O + canonical_units: m + description: land export + # + - standard_name: Sl_snowh_HDO + canonical_units: m + description: land export + # + - standard_name: Sl_t + canonical_units: K + description: land export + # + - standard_name: Sl_topo + canonical_units: m + description: land export + # + - standard_name: Sl_topo00 + canonical_units: m + description: land export + # + - standard_name: Sl_topo01 + canonical_units: m + description: land export + # + - standard_name: Sl_topo02 + canonical_units: m + description: land export + # + - standard_name: Sl_topo03 + canonical_units: m + description: land export + # + - standard_name: Sl_topo04 + canonical_units: m + description: land export + # + - standard_name: Sl_topo05 + canonical_units: m + description: land export + # + - standard_name: Sl_topo06 + canonical_units: m + description: land export + # + - standard_name: Sl_topo07 + canonical_units: m + description: land export + # + - standard_name: Sl_topo08 + canonical_units: m + description: land export + # + - standard_name: Sl_topo09 + canonical_units: m + description: land export + # + - standard_name: Sl_topo10 + canonical_units: m + description: land export + # + - standard_name: Sl_tref + canonical_units: K + description: land export + # + - standard_name: Sl_tsrf + canonical_units: deg C + description: land export + # + - standard_name: Sl_tsrf00 + canonical_units: deg C + description: land export + # + - standard_name: Sl_tsrf01 + canonical_units: deg C + description: land export + # + - standard_name: Sl_tsrf02 + canonical_units: deg C + description: land export + # + - standard_name: Sl_tsrf03 + canonical_units: deg C + description: land export + # + - standard_name: Sl_tsrf04 + canonical_units: deg C + description: land export + # + - standard_name: Sl_tsrf05 + canonical_units: deg C + description: land export + # + - standard_name: Sl_tsrf06 + canonical_units: deg C + description: land export + # + - standard_name: Sl_tsrf07 + canonical_units: deg C + description: land export + # + - standard_name: Sl_tsrf08 + canonical_units: deg C + description: land export + # + - standard_name: Sl_tsrf09 + canonical_units: deg C + description: land export + # + - standard_name: Sl_tsrf10 + canonical_units: deg C + description: land export + # + - standard_name: Sl_u10 + canonical_units: m + description: land export + # + #----------------------------------- + # section: atmosphere export + #----------------------------------- + # + - standard_name: Faxa_bcphidry + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_bcphiwet + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_bcphodry + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_dstdry1 + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_dstdry2 + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_dstdry3 + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_dstdry4 + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_dstwet1 + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_dstwet2 + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_dstwet3 + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_dstwet4 + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_swdn + alias: mean_down_sw_flx + canonical_units: W m-2 + description: atmosphere export + mean downward SW heat flux + # + - standard_name: Faxa_lwdn + alias: mean_down_lw_flx + canonical_units: W m-2 + description: atmosphere export + mean downward SW heat flux + # + - standard_name: Faxa_lwnet + alias: mean_net_lw_flx_atm + canonical_units: W m-2 + description: atmosphere export + mean merge longwave flux from atm (NEMS) + # + - standard_name: inst_down_lw_flx + canonical_units: W m-2 + description: atmosphere export + instantaneous downward long wave radiation flux (fv3 only) + # + - standard_name: inst_net_lw_flx_atm + canonical_units: W m-2 + description: atmosphere export + instantaneous NET long wave radiation flux (fv3 only) + # + - standard_name: inst_down_sw_flx + canonical_units: W m-2 + description: atmosphere export + instantaneous downward solar radiation flux (fv3 only) + # + - standard_name: inst_net_sw_flx + canonical_units: W m-2 + description: atmosphere export + instantaneous NET solar radiation flux over the ocean (fv3 only) + # + - standard_name: inst_net_sw_ir_dir_flx + canonical_units: W m-2 + description: atmosphere export + Instataneous net sfc nir direct flux (fv3 only) + # + - standard_name: inst_net_sw_ir_dif_flx + canonical_units: W m-2 + description: atmosphere export + Instataneous net sfc nir diffuse flux (fv3 only) + # + - standard_name: inst_net_sw_vis_dir_flx + canonical_units: W m-2 + description: atmosphere export + Instataneous net sfc uv+vis direct flux (fv3 only) + # + - standard_name: inst_net_sw_vis_dif_flx + canonical_units: W m-2 + description: atmosphere export + Instataneous net sfc uv+vis diffuse flux (fv3 only) + # + - standard_name: Faxa_nhx + canonical_units: kg(N)/m2/sec + description: atmosphere export + # + - standard_name: Faxa_noy + canonical_units: kg(N)/m2/sec + description: atmosphere export + # + - standard_name: Faxa_ocphidry + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_ocphiwet + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_ocphodry + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_prec + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_prec_16O + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_prec_18O + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_prec_HDO + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_rain + alias: mean_prec_rate + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_rain_16O + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_rain_18O + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_rain_HDO + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_rainc + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_rainc_16O + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_rainc_18O + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_rainc_HDO + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_rainl + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_rainl_16O + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_rainl_18O + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_rainl_HDO + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_snow + alias: mean_fprec_rate + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_snow_16O + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_snow_18O + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_snow_HDO + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_snowc + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_snowc_16O + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_snowc_18O + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_snowc_HDO + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_snowl + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_snowl_16O + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_snowl_18O + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_snowl_HDO + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_swnet + canonical_units: W m-2 + description: atmosphere export + # + - standard_name: Faxa_swndf + alias: mean_down_sw_ir_dif_flx + canonical_units: W m-2 + description: atmosphere export + mean surface downward nir diffuse flux + # + - standard_name: Faxa_swndr + alias: mean_down_sw_ir_dir_flx + canonical_units: W m-2 + description: atmosphere export + mean surface downward nir direct flux + # + - standard_name: Faxa_swvdf + alias: mean_down_sw_vis_dif_flx + canonical_units: W m-2 + description: atmosphere export + mean surface downward uv+vis diffuse flux + # + - standard_name: Faxa_swvdr + alias: mean_down_sw_vis_dir_flx + canonical_units: W m-2 + description: atmosphere export + mean surface downward uv+visvdirect flux + # + - standard_name: inst_down_sw_ir_dif_flx + canonical_units: W m-2 + description: atmosphere export + instataneous downward nir diffuse flux (fv3 only) + # + - standard_name: inst_down_sw_ir_dir_flx + canonical_units: W m-2 + description: atmosphere export + instataneous downward nir directflux (fv3 only) + # + - standard_name: inst_down_sw_vis_dif_flx + canonical_units: W m-2 + description: atmosphere export + instataneous downward uv+vis diffuse flux (fv3 only) + # + - standard_name: inst_down_sw_vis_dir_flx + canonical_units: W m-2 + description: atmosphere export + instataneous downward uv+vis directflux (fv3 only) + # + - standard_name: Sa_co2diag + canonical_units: 1e-6 mol/mol + description: atmosphere export + Diagnostic CO2 at the lowest model level (cesm only) + # + - standard_name: Sa_co2prog + canonical_units: 1e-6 mol/mol + description: atmosphere export + prognostic CO2 at the lowest model level (cesm only) + # + - standard_name: Sa_topo + alias: inst_surface_height + canonical_units: m + description: atmosphere export + topographic height + # + - standard_name: Sa_dens + alias: air_density_height_lowest + canonical_units: kg m-3 + description: atmosphere export + density at the lowest model layer (cesm only) + # + - standard_name: Sa_pbot + alias: inst_pres_height_lowest + canonical_units: Pa + description: atmosphere export + pressure at lowest model layer + # + - standard_name: Sa_pslv + alias: inst_pres_height_surface + canonical_units: Pa + description: atmosphere export + instataneous pressure land and sea surface + # + - standard_name: Sa_ptem + canonical_units: K + description: atmosphere export + bottom layer potential temperature (cesm only) + # + - standard_name: Sa_shum + alias: inst_spec_humid_height_lowest + canonical_units: kg kg-1 + description: atmosphere export + bottom layer specific humidity + # + - standard_name: Sa_shum_16O + canonical_units: kg kg-1 + description: atmosphere export + bottom layer specific humidity 16O (cesm only) + # + - standard_name: Sa_shum_18O + canonical_units: kg kg-1 + description: atmosphere export + bottom layer specific humidity 18O (cesm only) + # + - standard_name: Sa_shum_HDO + canonical_units: kg kg-1 + description: atmosphere export + bottom layer specific humidity HDO (cesm only) + # + - standard_name: inst_spec_humid_height2m + canonical_units: K + description: atmosphere export + instantaneous specific humidity 2m above ground (fv3 only) + # + - standard_name: Sa_tbot + alias: inst_temp_height_lowest + canonical_units: K + description: atmosphere export + bottom layer temperature + # + - standard_name: inst_temp_height2m + canonical_units: K + description: atmosphere export + instantaneous temperature 2m above ground (fv3 only) + # + - standard_name: Sa_u + alias: inst_zonal_wind_height_lowest + canonical_units: m s-1 + description: atmosphere export + bottom layer zonal wind + # + - standard_name: Sa_v + alias: inst_merid_wind_height_lowest + canonical_units: m s-1 + description: atmosphere export + bottom layer meridional wind + # + - standard_name: Sa_z + alias: inst_height_lowest + canonical_units: m + description: atmosphere export + bottom layer height + # + - standard_name: inst_zonal_wind_height10m + canonical_units: m s-1 + description: atmosphere export + instataneous u wind (m/s) 10 m above ground (fv3 only) + # + - standard_name: inst_merid_wind_height10m + canonical_units: m s-1 + description: atmosphere export + instataneous v wind (m/s) 10 m above ground (fv3 only) + # + - standard_name: inst_zonal_moment_flx + canonical_units: N m-2 + description: atmosphere export + instataneous zonal compt of momentum flux (fv3 only) + # + - standard_name: inst_merid_moment_flx + canonical_units: N m-2 + description: atmosphere export + instataneous merid compt of momentum flux (fv3 only) + # + - standard_name: inst_sensi_heat_flx + canonical_units: N m-2 + description: atmosphere export + instataneous sensible heat flux (fv3 only) + # + - standard_name: inst_laten_heat_flx + canonical_units: N m-2 + description: atmosphere export + instataneous latent heat flux (fv3 only) + # + - standard_name: inst_tracer_mass_frac + canonical_units: 1 + description: atmosphere export (fv3 only) + # + - standard_name: inst_pres_interface + canonical_units: Pa + description: atmosphere export (fv3 only) + # + - standard_name: inst_pres_levels + canonical_units: Pa + description: atmosphere export (fv3 only) + # + - standard_name: inst_geop_interface + canonical_units: tbd + description: atmosphere export (fv3 only) + # + - standard_name: inst_geop_levels + canonical_units: tbd + description: atmosphere export (fv3 only) + # + - standard_name: inst_temp_interface + canonical_units: K + description: atmosphere export (fv3 only) + # + - standard_name: inst_temp_levels + canonical_units: K + description: atmosphere export (fv3 only) + # + - standard_name: inst_zonal_wind_levels + canonical_units: m s-1 + description: atmosphere export (fv3 only) + # + - standard_name: inst_merid_wind_levels + canonical_units: m s-1 + description: atmosphere export (fv3 only) + # + - standard_name: inst_omega_levels + canonical_units: tbd + description: atmosphere export (fv3 only) + # + - standard_name: inst_tracer_mass_frac + canonical_units: 1 + description: atmosphere export (fv3 only) + # + - standard_name: inst_soil_moisture_content + canonical_units: tbd + description: atmosphere export (fv3 only) + # + - standard_name: soil_type + canonical_units: tbd + description: atmosphere export (fv3 only) + # + - standard_name: inst_pbl_height + canonical_units: tbd + description: atmosphere export (fv3 only) + # + - standard_name: surface_cell_area + canonical_units: tbd + description: atmosphere export (fv3 only) + # + - standard_name: inst_convective_rainfall_amount + canonical_units: tbd + description: atmosphere export (fv3 only) + # + - standard_name: inst_exchange_coefficient_heat_levels + canonical_units: tbd + description: atmosphere export (fv3 only) + # + - standard_name: inst_friction_velocity + canonical_units: tbd + description: atmosphere export (fv3 only) + # + - standard_name: inst_rainfall_amount + canonical_units: tbd + description: atmosphere export (fv3 only) + # + - standard_name: inst_land_sea_mask + canonical_units: tbd + description: atmosphere export (fv3 only) + # + - standard_name: inst_temp_height_surface + canonical_units: tbd + description: atmosphere export (fv3 only) + # + - standard_name: inst_up_sensi_heat_flx + canonical_units: tbd + description: atmosphere export (fv3 only) + # + - standard_name: inst_lwe_snow_thickness + canonical_units: tbd + description: atmosphere export (fv3 only) + # + - standard_name: vegetation_type + canonical_units: tbd + description: atmosphere export (fv3 only) + # + - standard_name: inst_vegetation_area_frac + canonical_units: tbd + description: atmosphere export (fv3 only) + # + - standard_name: inst_surface_roughness + canonical_units: tbd + description: atmosphere export (fv3 only) + +######### fv3 work + + - standard_name: Faxa_taux + alias: mean_zonal_moment_flx_atm + canonical_units: N m-2 + description: atmosphere export + zonal component of momentum flux + # + - standard_name: Faxa_tauy + alias: mean_merid_moment_flx_atm + canonical_units: N m-2 + description: atmosphere export + meridional component of momentum flux + # + - standard_name: Faxa_lat + alias: mean_laten_heat_flx_atm + canonical_units: W m-2 + description: atmosphere export + # + - standard_name: Faxa_sen + alias: mean_sensi_heat_flx_atm + canonical_units: W m-2 + description: atmosphere export + # + - standard_name: inst_zonal_moment_flx_atm + canonical_units: N m-2 + description: atmosphere export + zonal component of momentum flux + # + - standard_name: inst_merid_moment_flx_atm + canonical_units: N m-2 + description: atmosphere export + meridional component of momentum flux + # + - standard_name: inst_laten_heat_flx_atm + canonical_units: W m-2 + description: atmosphere export + # + - standard_name: inst_sensi_heat_flx_atm + canonical_units: W m-2 + description: atmosphere export + +### FV3 work - NEMS S2S benchmark (not including fractional branch) + + - standard_name: mean_up_lw_flx + alias: Faxx_lwup + canonical_units: W m-2 + description: atmosphere import - merged ocn/ice flux + +############ + # + #----------------------------------- + # section: atmosphere import + #----------------------------------- + # + - standard_name: Faxx_evap + canonical_units: kg m-2 s-1 + description: atmosphere import + # + - standard_name: Faxx_evap_16O + canonical_units: kg m-2 s-1 + description: atmosphere import + # + - standard_name: Faxx_evap_18O + canonical_units: kg m-2 s-1 + description: atmosphere import + # + - standard_name: Faxx_evap_HDO + canonical_units: kg m-2 s-1 + description: atmosphere import + # + - standard_name: Faxx_lat + alias: mean_laten_heat_flx + canonical_units: W m-2 + description: atmosphere import (cesm) or sent from atm (fv3) + # + - standard_name: Faxx_lwup + canonical_units: W m-2 + description: atmosphere import + # + - standard_name: Faxx_sen + alias: mean_sensi_heat_flx + canonical_units: W m-2 + description: atmosphere import + # + - standard_name: Faxx_taux + alias: mean_zonal_moment_flx + canonical_units: N m-2 + description: atmosphere import + zonal component of momentum flux + for fv3, for sea ice covered area + for cesm, merged ice/ocn/land + # + - standard_name: Faxx_tauy + alias: mean_merid_moment_flx + canonical_units: N m-2 + description: atmosphere import + meridional component of momentum flux + for fv3, for sea ice covered area + for cesm, merged ice/ocn/land + # + - standard_name: Sx_anidf + canonical_units: 1 + description: atmosphere import + # + - standard_name: Sx_anidr + canonical_units: 1 + description: atmosphere import + # + - standard_name: Sx_avsdf + canonical_units: 1 + description: atmosphere import + # + - standard_name: Sx_avsdr + canonical_units: 1 + description: atmosphere import + # + - standard_name: Sx_qref + canonical_units: kg kg-1 + description: atmosphere import + # + - standard_name: Sx_qref_16O + canonical_units: kg kg-1 + # + - standard_name: Sx_qref_18O + canonical_units: kg kg-1 + description: atmosphere import + # + - standard_name: Sx_qref_HDO + canonical_units: kg kg-1 + description: atmosphere import + # + - standard_name: Sx_t + alias: surface_temperature + canonical_units: K + description: atmosphere import + # + - standard_name: Sx_tref + canonical_units: K + description: atmosphere import + # + - standard_name: Sx_u10 + canonical_units: m + description: atmosphere import + # + #----------------------------------- + # section: land-ice export + # Note that the fields sent from glc->med do NOT have elevation classes, + # but the fields from med->lnd are broken into multiple elevation classes + #----------------------------------- + # + - standard_name: Figg_rofi + canonical_units: kg m-2 s-1 + description: land-ice export + glc frozen runoff_iceberg flux to ice + # + - standard_name: Figg_rofi_16O + canonical_units: kg m-2 s-1 + description: land-ice export + glc frozen runoff_iceberg flux to ice for 16O + # + - standard_name: Figg_rofi_18O + canonical_units: kg m-2 s-1 + description: land-ice export + glc frozen runoff_iceberg flux to ice for 18O + # + - standard_name: Figg_rofi_HDO + canonical_units: kg m-2 s-1 + description: land-ice export + glc frozen runoff_iceberg flux to ice for HDO + # + - standard_name: Flgg_hflx + canonical_units: W m-2 + description: land-ice export + Downward heat flux from glacier interior, from glc + # + - standard_name: Flgg_hflx00 + canonical_units: W m-2 + description: land-ice export + Downward heat flux from glacier interior, from mediator, elev class 0 + # + - standard_name: Flgg_hflx01 + canonical_units: W m-2 + description: land-ice export + Downward heat flux from glacier interior, from mediator, elev class 1 + # + - standard_name: Flgg_hflx02 + canonical_units: W m-2 + description: land-ice export + Downward heat flux from glacier interior, from mediator, elev class 2 + # + - standard_name: Flgg_hflx03 + canonical_units: W m-2 + description: land-ice export + Downward heat flux from glacier interior, from mediator, elev class 3 + # + - standard_name: Flgg_hflx04 + canonical_units: W m-2 + description: land-ice export + Downward heat flux from glacier interior, from mediator, elev class 4 + # + - standard_name: Flgg_hflx05 + canonical_units: W m-2 + description: land-ice export + Downward heat flux from glacier interior, from mediator, elev class 5 + # + - standard_name: Flgg_hflx06 + canonical_units: W m-2 + description: land-ice export + Downward heat flux from glacier interior, from mediator, elev class 6 + # + - standard_name: Flgg_hflx07 + canonical_units: W m-2 + description: land-ice export + Downward heat flux from glacier interior, from mediator, elev class 7 + # + - standard_name: Flgg_hflx08 + canonical_units: W m-2 + description: land-ice export + Downward heat flux from glacier interior, from mediator, elev class 8 + # + - standard_name: Flgg_hflx09 + canonical_units: W m-2 + description: land-ice export + Downward heat flux from glacier interior, from mediator, elev class 8 + # + - standard_name: Flgg_hflx10 + canonical_units: W m-2 + description: land-ice export + Downward heat flux from glacier interior, from mediator, elev class 10 + - standard_name: Sg_ice_covered + canonical_units: 1 + # + - standard_name: Sg_ice_covered00 + canonical_units: 1 + description: land-ice export + # + - standard_name: Sg_ice_covered01 + canonical_units: 1 + description: land-ice export + # + - standard_name: Sg_ice_covered02 + canonical_units: 1 + description: land-ice export + # + - standard_name: Sg_ice_covered03 + canonical_units: 1 + description: land-ice export + # + - standard_name: Sg_ice_covered04 + canonical_units: 1 + description: land-ice export + # + - standard_name: Sg_ice_covered05 + canonical_units: 1 + description: land-ice export + # + - standard_name: Sg_ice_covered06 + canonical_units: 1 + description: land-ice export + # + - standard_name: Sg_ice_covered07 + canonical_units: 1 + description: land-ice export + # + - standard_name: Sg_ice_covered08 + canonical_units: 1 + description: land-ice export + # + - standard_name: Sg_ice_covered09 + canonical_units: 1 + description: land-ice export + # + - standard_name: Sg_ice_covered10 + canonical_units: 1 + description: land-ice export + # + - standard_name: Sg_icemask + canonical_units: 1 + description: land-ice export + # + - standard_name: Sg_icemask_coupled_fluxes + canonical_units: 1 + description: land-ice export + # + - standard_name: Sg_topo + canonical_units: m + description: land-ice export + # + - standard_name: Sg_topo00 + canonical_units: m + description: land-ice export + # + - standard_name: Sg_topo01 + canonical_units: m + description: land-ice export + # + - standard_name: Sg_topo02 + canonical_units: m + description: land-ice export + # + - standard_name: Sg_topo03 + canonical_units: m + description: land-ice export + # + - standard_name: Sg_topo04 + canonical_units: m + description: land-ice export + # + - standard_name: Sg_topo05 + canonical_units: m + description: land-ice export + # + - standard_name: Sg_topo06 + canonical_units: m + description: land-ice export + # + - standard_name: Sg_topo07 + canonical_units: m + description: land-ice export + # + - standard_name: Sg_topo08 + canonical_units: m + description: land-ice export + # + - standard_name: Sg_topo09 + canonical_units: m + description: land-ice export + # + - standard_name: Sg_topo10 + canonical_units: m + description: land-ice export + # + - standard_name: Fogg_rofi + canonical_units: kg m-2 s-1 + description: land-ice export + glacier_frozen_runoff_flux_to_ocean + # + - standard_name: Fogg_rofi_16O + canonical_units: kg m-2 s-1 + description: land-ice export + glacier_frozen_runoff_flux_to_ocean for 16O + # + - standard_name: Fogg_rofi_18O + canonical_units: kg m-2 s-1 + description: land-ice export + glacier_frozen_runoff_flux_to_ocean for 18O + # + - standard_name: Fogg_rofi_HDO + canonical_units: kg m-2 s-1 + description: land-ice export + glacier_frozen_runoff_flux_to_ocean for HDO + # + - standard_name: Fogg_rofl + canonical_units: kg m-2 s-1 + description: land-ice export + glacier liquid runoff flux to ocean + # + - standard_name: Fogg_rofl_16O + canonical_units: kg m-2 s-1 + description: land-ice export + glacier_frozen_runoff_flux_to_ocean for 16O + # + - standard_name: Fogg_rofl_18O + canonical_units: kg m-2 s-1 + description: land-ice export + glacier_frozen_runoff_flux_to_ocean for 18O + # + - standard_name: Fogg_rofl_HDO + canonical_units: kg m-2 s-1 + description: land-ice export + glacier_frozen_runoff_flux_to_ocean for HDO + # + #----------------------------------- + # section: sea-ice export + #----------------------------------- + # + - standard_name: Faii_evap + alias: mean_evap_rate_atm_into_ice + canonical_units: kg m-2 s-1 + description: sea-ice export + # + - standard_name: Faii_evap_16O + canonical_units: kg m-2 s-1 + description: sea-ice export + # + - standard_name: Faii_evap_18O + canonical_units: kg m-2 s-1 + description: sea-ice export + # + - standard_name: Faii_evap_HDO + canonical_units: kg m-2 s-1 + description: sea-ice export + # + - standard_name: Faii_lat + alias: mean_laten_heat_flx_atm_into_ice + canonical_units: W m-2 + description: sea-ice export to atm + atm/ice latent heat flux + # + - standard_name: Faii_sen + alias: mean_sensi_heat_flx_atm_into_ice + canonical_units: W m-2 + description: sea-ice export to atm + atm/ice sensible heat flux + # + - standard_name: Faii_lwup + alias: mean_up_lw_flx_ice + canonical_units: W m-2 + description: sea-ice export + outgoing logwave radiation + # + - standard_name: Faii_swnet + canonical_units: W m-2 + description: sea-ice export to atm + # + - standard_name: Faii_taux + alias: stress_on_air_ice_zonal + canonical_units: N m-2 + description: sea-ice export to atm + air ice zonal stress + # + - standard_name: Faii_tauy + alias: stress_on_air_ice_merid + canonical_units: N m-2 + description: sea-ice export + air ice meridional stress + # + - standard_name: Fioi_bcphi + canonical_units: kg m-2 s-1 + description: sea-ice export to ocean + hydrophilic black carbon flux to ocean + # + - standard_name: Fioi_bcpho + canonical_units: kg m-2 s-1 + description: sea-ice export to ocean + hydrophobic black carbon flux to ocean + # + - standard_name: Fioi_flxdst + canonical_units: kg m-2 s-1 + description: sea-ice export to ocean + dust aerosol flux to ocean + # + - standard_name: Fioi_melth + alias: net_heat_flx_to_ocn + canonical_units: W m-2 + description: sea-ice export to ocean + net heat flux to ocean + # + - standard_name: Fioi_melth_16O + canonical_units: kg m-2 s-1 + description: sea-ice export to ocean + isotope head flux to ocean + # + - standard_name: Fioi_melth_18O + canonical_units: kg m-2 s-1 + description: sea-ice export to ocean + isotope head flux to ocean + # + - standard_name: Fioi_melth_HDO + canonical_units: kg m-2 s-1 + description: sea-ice export to ocean + isotope head flux to ocean + # + - standard_name: Fioi_meltw + alias: mean_fresh_water_to_ocean_rate + canonical_units: kg m-2 s-1 + description: sea-ice export to ocean + fresh water to ocean (h2o flux from melting) + # + - standard_name: Fioi_meltw_16O + canonical_units: kg m-2 s-1 + description: sea-ice export + # + - standard_name: Fioi_meltw_18O + canonical_units: kg m-2 s-1 + description: sea-ice export + # + - standard_name: Fioi_meltw_HDO + canonical_units: kg m-2 s-1 + description: sea-ice export + # + - standard_name: Fioi_salt + alias: mean_salt_rate + canonical_units: kg m-2 s-1 + description: sea-ice export to ocean + salt to ocean (salt flux from melting) + # + - standard_name: Fioi_swpen + alias: mean_sw_pen_to_ocn + canonical_units: W m-2 + description: sea-ice export to ocean + flux of shortwave through ice to ocean + # + # NOTE: the following alias requires a new name change for CICE export + - standard_name: Fioi_swpen_vdr + alias: mean_net_swpen_vis_dir_flx + canonical_units: W m-2 + description: sea-ice export to ocean + flux of vis dir shortwave through ice to ocean + # + # NOTE: the following alias requires a new name change for CICE export + - standard_name: Fioi_swpen_vdf + alias: mean_net_swpen_vis_dif_flx + canonical_units: W m-2 + description: sea-ice export to ocean + flux of vif dir shortwave through ice to ocean + # + # NOTE: the following alias requires a new name change for CICE export + - standard_name: Fioi_swpen_idr + alias: mean_net_swpen_ir_dir_flx + canonical_units: W m-2 + description: sea-ice export to ocean + flux of ir dir shortwave through ice to ocean + # + # NOTE: the following alias requires a new name change for CICE export + - standard_name: Fioi_swpen_idf + alias: mean_net_swpen_ir_dif_flx + canonical_units: W m-2 + description: sea-ice export to ocean + flux of ir dif shortwave through ice to ocean + # + - standard_name: Fioi_taux + alias: stress_on_ocn_ice_zonal + canonical_units: N m-2 + description: sea-ice export to ocean + ice ocean zonal stress + # + - standard_name: Fioi_tauy + alias: stress_on_ocn_ice_merid + canonical_units: N m-2 + description: sea-ice export to ocean + ice ocean meridional stress + # + - standard_name: Si_anidf + alias: inst_ice_ir_dif_albedo + canonical_units: 1 + description: sea-ice export to atm + # + - standard_name: Si_anidr + alias: inst_ice_ir_dir_albedo + canonical_units: 1 + description: sea-ice export to atm + # + - standard_name: Si_avsdf + alias: inst_ice_vis_dif_albedo + canonical_units: 1 + description: sea-ice export to atm + # + - standard_name: Si_avsdr + alias: inst_ice_vis_dir_albedo + canonical_units: 1 + description: sea-ice export to atm + # + - standard_name: Si_ifrac + alias: ice_fraction + canonical_units: 1 + description: sea-ice export to atm + ice fraction (varies with time) + # + - standard_name: Si_ifrac_n + canonical_units: 1 + description: sea-ice export + ice fraction per category (varies with time) (cesm only) + # + - standard_name: Si_imask + alias: ice_mask + canonical_units: 1 + description: sea-ice export + ice mask + # + - standard_name: Si_qref + canonical_units: kg kg-1 + description: sea-ice export to atm + cesm only + # + - standard_name: Si_qref_16O + canonical_units: kg kg-1 + description: sea-ice export to atm + cesm only + # + - standard_name: Si_qref_18O + canonical_units: kg kg-1 + description: sea-ice export to atm + cesm only + # + - standard_name: Si_qref_HDO + canonical_units: kg kg-1 + description: sea-ice export + cesm only + # + - standard_name: Si_snowh +# ambiguous with Si_vsno +# alias: mean_snow_volume + canonical_units: m + description: sea-ice export + volume of snow per unit area + # + - standard_name: Si_t + alias: sea_ice_temperature + canonical_units: K + description: sea-ice export + # + - standard_name: Si_tref + canonical_units: K + description: sea-ice export + # + - standard_name: Si_u10 + canonical_units: m + description: sea-ice export + # + - standard_name: Si_vice + alias: mean_ice_volume + canonical_units: m + description: sea-ice export + volume of ice per unit area + # + - standard_name: Si_vsno + alias: mean_snow_volume + canonical_units: m + description: sea-ice export + volume of snow per unit area + # + #----------------------------------- + # section: ocean export to mediator + #----------------------------------- + # + - standard_name: Fioo_q + alias: freezing_melting_potential + canonical_units: W m-2 + description: ocean export + # + - standard_name: Faoo_fco2_ocn + canonical_units: moles m-2 s-1 + description: ocean export (cesm only) + # + - standard_name: So_anidf + canonical_units: 1 + description: ocean export (cesm only) + # + - standard_name: So_anidr + canonical_units: 1 + description: ocean export (cesm only) + # + - standard_name: So_avsdf + canonical_units: 1 + description: ocean export (cesm only) + # + - standard_name: So_avsdr + canonical_units: 1 + description: ocean export (cesm only) + # + - standard_name: So_bldepth + alias: mixed_layer_depth + canonical_units: m + description: ocean export + # + - standard_name: So_dhdx + alias: sea_surface_slope_zonal + canonical_units: m m-1 + description: ocean export + # + - standard_name: So_dhdy + alias: sea_surface_slope_merid + canonical_units: m m-1 + description: ocean export + # + - standard_name: So_duu10n + canonical_units: m2 s-2 + description: ocean export + # + - standard_name: So_fswpen + canonical_units: 1 + description: ocean export + # + - standard_name: So_ofrac + canonical_units: 1 + description: ocean export + # + - standard_name: So_omask + alias: ocean_mask + canonical_units: 1 + description: ocean export + # + - standard_name: So_qref + canonical_units: kg kg-1 + description: ocean export + # + - standard_name: So_qref_16O + canonical_units: kg kg-1 + description: ocean export + # + - standard_name: So_qref_18O + canonical_units: kg kg-1 + description: ocean export + # + - standard_name: So_qref_HDO + canonical_units: kg kg-1 + description: ocean export + # + - standard_name: So_re + canonical_units: 1 + description: ocean export + # + - standard_name: So_roce_16O + canonical_units: 1 + description: ocean export + # + - standard_name: So_roce_HDO + canonical_units: 1 + description: ocean export + # + - standard_name: So_s + alias: s_surf + canonical_units: g kg-1 + description: ocean export + # + - standard_name: So_ssq + canonical_units: kg kg-1 + description: ocean export + # + - standard_name: So_t + alias: sea_surface_temperature + canonical_units: K + description: ocean export + # + - standard_name: So_tref + canonical_units: K + description: ocean export + # + - standard_name: So_u + alias: ocn_current_zonal + canonical_units: m s-1 + description: ocean export + # + - standard_name: So_u10 + canonical_units: m + description: ocean export + # + - standard_name: So_ustar + canonical_units: m s-1 + description: ocean export + # + - standard_name: So_v + alias: ocn_current_merid + canonical_units: m s-1 + description: ocean export + # + #----------------------------------- + # section: river export + #----------------------------------- + # + - standard_name: Firr_rofi + canonical_units: kg m-2 s-1 + description: river export + water flux into sea ice due to runoff (frozen) + # + - standard_name: Firr_rofi_16O + canonical_units: kg m-2 s-1 + description: river export + water flux into sea ice due to runoff (frozen) for 16O + # + - standard_name: Firr_rofi_18O + canonical_units: kg m-2 s-1 + description: river export + water flux into sea ice due to runoff (frozen) for 18O + # + - standard_name: Firr_rofi_HDO + canonical_units: kg m-2 s-1 + description: river export + water flux into sea ice due to runoff (frozen) for HDO + # + - standard_name: Fixx_rofi + canonical_units: kg m-2 s-1 + description: frozen runoff to ice from river and land-ice + # + - standard_name: Fixx_rofi_16O + canonical_units: kg m-2 s-1 + description: frozen runoff to ice from river and land-ice for 16O + # + - standard_name: Fixx_rofi_18O + canonical_units: kg m-2 s-1 + description: frozen runoff to ice from river and land-ice for 18O + # + - standard_name: Fixx_rofi_HDO + canonical_units: kg m-2 s-1 + description: frozen runoff to ice from river and land-ice for HDO + # + #----------------------------------- + # section: lnd export to glc + #----------------------------------- + # + - standard_name: Flgl_qice + canonical_units: kg m-2 s-1 + description: land export to glc + # + - standard_name: Flgl_qice00 + canonical_units: kg m-2 s-1 + description: land export to glc + # + - standard_name: Flgl_qice01 + canonical_units: kg m-2 s-1 + description: land export to glc + # + - standard_name: Flgl_qice02 + canonical_units: kg m-2 s-1 + description: land export to glc + # + - standard_name: Flgl_qice03 + canonical_units: kg m-2 s-1 + description: land export to glc + # + - standard_name: Flgl_qice04 + canonical_units: kg m-2 s-1 + description: land export to glc + # + - standard_name: Flgl_qice05 + canonical_units: kg m-2 s-1 + description: land export to glc + # + - standard_name: Flgl_qice06 + canonical_units: kg m-2 s-1 + description: land export to glc + # + - standard_name: Flgl_qice07 + canonical_units: kg m-2 s-1 + description: land export to glc + # + - standard_name: Flgl_qice08 + canonical_units: kg m-2 s-1 + description: land export to glc + # + - standard_name: Flgl_qice09 + canonical_units: kg m-2 s-1 + description: land export to glc + # + - standard_name: Flgl_qice10 + canonical_units: kg m-2 s-1 + description: land export to glc + # + #----------------------------------- + # section: lnd export to river + #----------------------------------- + # + - standard_name: Flrl_irrig + canonical_units: kg m-2 s-1 + description: land export to river + # + - standard_name: Flrl_rofdto + canonical_units: kg m-2 s-1 + description: land export to river + # + - standard_name: Flrl_rofgwl + canonical_units: kg m-2 s-1 + description: land export to river + # + - standard_name: Flrl_rofi + canonical_units: kg m-2 s-1 + description: land export to river + # + - standard_name: Flrl_rofsub + canonical_units: kg m-2 s-1 + description: land export to river + # + - standard_name: Flrl_rofsur + canonical_units: kg m-2 s-1 + description: land export to river + # + #----------------------------------- + # section: river export + #----------------------------------- + # + - standard_name: Flrr_flood + canonical_units: kg m-2 s-1 + description: river export to land + Water flux due to flooding + # + - standard_name: Flrr_flood_16O + canonical_units: kg m-2 s-1 + description: river export to land + Water flux due to flooding for 16O + # + - standard_name: Flrr_flood_18O + canonical_units: kg m-2 s-1 + description: river export to land + Water flux due to flooding for 18O + # + - standard_name: Flrr_flood_HDO + canonical_units: kg m-2 s-1 + description: river export to land + Water flux due to flooding for HDO + # + - standard_name: Flrr_volr + canonical_units: m + description: river export to land + River channel total water volume + # + - standard_name: Flrr_volr_16O + canonical_units: m + description: river export to land + River channel total water volume from 16O + # + - standard_name: Flrr_volr_18O + canonical_units: m + description: river export to land + River channel total water volume from 18O + # + - standard_name: Flrr_volr_HDO + canonical_units: m + description: river export to land + River channel total water olume from HDO + # + - standard_name: Flrr_volrmch + canonical_units: m + description: river export to land + River channel main channel water volume + # + - standard_name: Flrr_volrmch_16O + canonical_units: m + description: river export to land + River channel main channel water volume from 16O + # + - standard_name: Flrr_volrmch_18O + canonical_units: m + description: river export to land + River channel main channel water volume from 18O + # + - standard_name: Flrr_volrmch_HDO + canonical_units: m + description: river export to land + River channel main channel water volume from HDO + # + - standard_name: Forr_rofi + canonical_units: kg m-2 s-1 + description: river export to ocean + Water flux due to runoff (frozen) + # + - standard_name: Forr_rofi_16O + canonical_units: kg m-2 s-1 + description: river export to ocean + Water flux due to runoff (frozen) for 16O + # + - standard_name: Forr_rofi_18O + canonical_units: kg m-2 s-1 + description: river export to ocean + Water flux due to runoff (frozen) for 18O + # + - standard_name: Forr_rofi_HDO + canonical_units: kg m-2 s-1 + description: river export to ocean + Water flux due to runoff (frozen) for HDO + # + - standard_name: Forr_rofl + canonical_units: kg m-2 s-1 + description: river export to ocean + Water flux due to runoff (liquid) + # + - standard_name: Forr_rofl_16O + canonical_units: kg m-2 s-1 + description: river export to ocean + Water flux due to runoff (frozen) for 16O + # + - standard_name: Forr_rofl_18O + canonical_units: kg m-2 s-1 + description: river export to ocean + Water flux due to runoff (frozen) for 18O + # + - standard_name: Forr_rofl_HDO + canonical_units: kg m-2 s-1 + description: river export to ocean + Water flux due to runoff (frozen) for HDO + # + #----------------------------------- + # section: ocean import + #----------------------------------- + # + - standard_name: Foxx_evap + alias: mean_evap_rate + canonical_units: kg m-2 s-1 + description: ocean import + specific humidity flux + # + - standard_name: Foxx_evap_16O + canonical_units: kg m-2 s-1 + description: ocean import + specific humidity flux 16O + # + - standard_name: Foxx_evap_18O + canonical_units: kg m-2 s-1 + description: ocean import + specific humidity flux 18O + # + - standard_name: Foxx_evap_HDO + canonical_units: kg m-2 s-1 + description: ocean import + specific humidity flux HDO + # + - standard_name: Foxx_lat + canonical_units: W m-2 + description: ocean import + latent heat flux into ocean (cesm only) + # + - standard_name: Foxx_lat_16O + canonical_units: W m-2 + description: ocean import + latent heat flux into ocean for 16O (cesm only) + # + - standard_name: Foxx_lat_18O + canonical_units: W m-2 + description: ocean import + latent heat flux into ocean for 16O (cesm only) + # + - standard_name: Foxx_lat_HDO + canonical_units: W m-2 + description: ocean import + latent heat flux into ocean for 18O (cesm only) + # + - standard_name: Foxx_lat + canonical_units: W m-2 + description: ocean import + latent heat flux into ocean for HDO (cesm only) + # + - standard_name: Foxx_sen + alias: mean_sensi_heat_flx + canonical_units: W m-2 + description: ocean import + sensible heat flux into ocean + # + - standard_name: Foxx_lwup + canonical_units: W m-2 + description: ocean import + surface upward longwave heat flux + # + - standard_name: Foxx_lwnet + alias: mean_net_lw_flx + canonical_units: W m-2 + description: ocean import + mean NET long wave radiation flux to ocean + # + - standard_name: mean_runoff_rate + canonical_units: kg m-2 s-1 + description: ocean import + total runoff to ocean + # + - standard_name: mean_runoff_heat_flux + canonical_units: kg m-2 s-1 + description: ocean import + heat content of runoff + # + - standard_name: mean_calving_rate + canonical_units: kg m-2 s-1 + description: ocean import + total calving to ocean + # + - standard_name: mean_calving_heat_flux + canonical_units: kg m-2 s-1 + description: ocean import + heat content of calving + # + - standard_name: Foxx_rofi + canonical_units: kg m-2 s-1 + description: ocean import + water flux due to runoff (frozen) + # + - standard_name: Foxx_rofi_16O + canonical_units: kg m-2 s-1 + description: ocean import + water flux due to runoff (frozen) for 16O + # + - standard_name: Foxx_rofi_18O + canonical_units: kg m-2 s-1 + description: ocean import + water flux due to runoff (frozen) for 18O + # + - standard_name: Foxx_rofi_HDO + canonical_units: kg m-2 s-1 + description: ocean import + water flux due to runoff (frozen) for HDO + # + - standard_name: Foxx_rofl + alias: mean_runoff_rate + canonical_units: kg m-2 s-1 + description: ocean import + water flux due to runoff (liquid) + # + - standard_name: Foxx_rofl_16O + canonical_units: kg m-2 s-1 + description: ocean import + water flux due to runoff (liquid) for 16O + # + - standard_name: Foxx_rofl_18O + canonical_units: kg m-2 s-1 + description: ocean import + water flux due to runoff (liquid) for 18O + # + - standard_name: Foxx_rofl_HDO + canonical_units: kg m-2 s-1 + description: ocean import + water flux due to runoff (liquid) for HDO + # + - standard_name: Foxx_swnet + alias: mean_net_sw_flx + canonical_units: W m-2 + description: ocean import + net shortwave radiation to ocean + # + - standard_name: Foxx_swnet_vdr + alias: mean_net_sw_vis_dir_flx + canonical_units: W m-2 + description: ocean import + net shortwave visible direct radiation to ocean + # + - standard_name: Foxx_swnet_vdf + alias: mean_net_sw_vis_dif_flx + canonical_units: W m-2 + description: ocean import + net shortwave visible diffuse radiation to ocean + # + - standard_name: Foxx_swnet_idr + alias: mean_net_sw_ir_dir_flx + canonical_units: W m-2 + description: ocean import + net shortwave ir direct radiation to ocean + # + - standard_name: Foxx_swnet_idf + alias: mean_net_sw_ir_dif_flx + canonical_units: W m-2 + description: ocean import + net shortwave ir diffuse radiation to ocean + # + - standard_name: Foxx_swnet_afracr + canonical_units: W m-2 + description: ocean import + net shortwave radiation times atmosphere fraction (cesm only) + # + - standard_name: Foxx_taux + alias: mean_zonal_moment_flx + canonical_units: N m-2 + description: ocean import + zonal surface stress + # + - standard_name: Foxx_tauy + alias: mean_merid_moment_flx + canonical_units: N m-2 + description: ocean import + meridional surface stress + # + - standard_name: Fioi_swpen_ifrac_n + canonical_units: W m-2 + description: ocean import + net shortwave radiation penetrating into ice and ocean times ice fraction for thickness category 1 + cesm only + # + - standard_name: Sf_afrac + canonical_units: 1 + description: ocean import + fractional atmosphere coverage wrt ocean + cesm only + # + - standard_name: Sf_afracr + canonical_units: 1 + description: ocean import + fractional atmosphere coverage used in radiation computations wrt ocean + cesm only + # + - standard_name: Sw_hstokes + canonical_units: m + description: ocean import + Stokes drift depth + cesm only + # + - standard_name: Sw_lamult + canonical_units: 1 + description: ocean import + Langmuir multiplier + cesm only + # + - standard_name: Sw_ustokes + canonical_units: m/s + description: ocean import + Stokes drift u component + cesm only + # + - standard_name: Sw_vstokes + canonical_units: m/s + description: ocean import + Stokes drift v component + cesm only + # + #----------------------------------- + # mediator fields + #----------------------------------- + # + - standard_name: cpl_scalars + canonical_units: unitless + description: mediator field + # + - standard_name: frac + canonical_units: 1 + # + - standard_name: mask + canonical_units: 1 diff --git a/src/mediator/ESMFConvenienceMacros.h b/src/mediator/ESMFConvenienceMacros.h new file mode 100644 index 00000000..09276058 --- /dev/null +++ b/src/mediator/ESMFConvenienceMacros.h @@ -0,0 +1,7 @@ +#if 0 +// ----------- ERROR handling macros ------------------------------------------ +#endif + +#define ESMF_ERR_ABORT(rc) if (ESMF_LogFoundError(rc, msg="Aborting NEMS", line=__LINE__, file=__FILE__)) call ESMF_Finalize(endflag=ESMF_END_ABORT) + +#define ESMF_ERR_RETURN(rc,rcOut) if (ESMF_LogFoundError(rc, msg="Breaking out of subroutine", line=__LINE__, file=__FILE__, rcToReturn=rcOut)) return diff --git a/src/mediator/ESMFVersionDefine.h b/src/mediator/ESMFVersionDefine.h new file mode 100644 index 00000000..0038c9db --- /dev/null +++ b/src/mediator/ESMFVersionDefine.h @@ -0,0 +1,9 @@ +#if 0 +// +// Make this header file available as ESMFVersionDefine.h in order to build +// NEMS against an ESMF installation that contains a reference level NUOPC Layer. +// +#endif + +#include "./ESMFConvenienceMacros.h" + diff --git a/src/mediator/med.F90 b/src/mediator/med.F90 new file mode 100644 index 00000000..623b66a6 --- /dev/null +++ b/src/mediator/med.F90 @@ -0,0 +1,2116 @@ +module MED + + !----------------------------------------------------------------------------- + ! Mediator Component. + !----------------------------------------------------------------------------- + + use med_constants_mod , only: CX, R8, CL + use med_constants_mod , only: dbug_flag => med_constants_dbug_flag + use med_constants_mod , only: spval_init => med_constants_spval_init + use med_constants_mod , only: spval => med_constants_spval + use med_constants_mod , only: czero => med_constants_czero + use med_constants_mod , only: ispval_mask => med_constants_ispval_mask + use shr_nuopc_methods_mod , only: shr_nuopc_methods_ChkErr + + implicit none + private + + public SetServices + + private InitializeP0 + private InitializeIPDv03p1 ! advertise fields + private InitializeIPDv03p3 ! realize connected Fields with transfer action "provide" + private InitializeIPDv03p4 ! optionally modify the decomp/distr of transferred Grid/Mesh + private InitializeIPDv03p5 ! realize all Fields with transfer action "accept" + private DataInitialize ! finish initialization and resolve data dependencies + private SetRunClock + private med_finalize + + character(len=*), parameter :: grid_arbopt = "grid_reg" ! grid_reg or grid_arb + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!----------------------------------------------------------------------------- +contains +!----------------------------------------------------------------------------- + + subroutine SetServices(gcomp, rc) + use ESMF , only: ESMF_SUCCESS, ESMF_GridCompSetEntryPoint, ESMF_METHOD_INITIALIZE, ESMF_METHOD_RUN + use ESMF , only: ESMF_GridComp, ESMF_MethodRemove + use NUOPC , only: NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize, NUOPC_NOOP + use NUOPC_Mediator , only: mediator_routine_SS => SetServices + use NUOPC_Mediator , only: mediator_routine_Run => routine_Run + use NUOPC_Mediator , only: mediator_label_DataInitialize => label_DataInitialize + use NUOPC_Mediator , only: mediator_label_Advance => label_Advance + use NUOPC_Mediator , only: mediator_label_CheckImport => label_CheckImport + use NUOPC_Mediator , only: mediator_label_TimestampExport => label_TimestampExport + use NUOPC_Mediator , only: mediator_label_SetRunClock => label_SetRunClock + use NUOPC_Mediator , only: mediator_label_Finalize => label_Finalize + use med_phases_history_mod , only: med_phases_history_write + use med_phases_restart_mod , only: med_phases_restart_write + use med_connectors_mod , only: med_connectors_prep_med2atm + use med_connectors_mod , only: med_connectors_prep_med2ocn + use med_connectors_mod , only: med_connectors_prep_med2ice + use med_connectors_mod , only: med_connectors_prep_med2lnd + use med_connectors_mod , only: med_connectors_prep_med2rof + use med_connectors_mod , only: med_connectors_prep_med2wav + use med_connectors_mod , only: med_connectors_prep_med2glc + use med_connectors_mod , only: med_connectors_post_atm2med + use med_connectors_mod , only: med_connectors_post_ocn2med + use med_connectors_mod , only: med_connectors_post_ice2med + use med_connectors_mod , only: med_connectors_post_lnd2med + use med_connectors_mod , only: med_connectors_post_rof2med + use med_connectors_mod , only: med_connectors_post_wav2med + use med_connectors_mod , only: med_connectors_post_glc2med + use med_phases_prep_atm_mod , only: med_phases_prep_atm + use med_phases_prep_ice_mod , only: med_phases_prep_ice + use med_phases_prep_lnd_mod , only: med_phases_prep_lnd + use med_phases_prep_wav_mod , only: med_phases_prep_wav + use med_phases_prep_glc_mod , only: med_phases_prep_glc + use med_phases_prep_rof_mod , only: med_phases_prep_rof_accum_fast + use med_phases_prep_rof_mod , only: med_phases_prep_rof_avg + use med_phases_prep_ocn_mod , only: med_phases_prep_ocn_map + use med_phases_prep_ocn_mod , only: med_phases_prep_ocn_merge + use med_phases_prep_ocn_mod , only: med_phases_prep_ocn_accum_fast + use med_phases_prep_ocn_mod , only: med_phases_prep_ocn_accum_avg + use med_phases_ocnalb_mod , only: med_phases_ocnalb_run + use med_phases_aofluxes_mod , only: med_phases_aofluxes_run + use med_fraction_mod , only: med_fraction_init, med_fraction_set + use med_phases_profile_mod , only: med_phases_profile + + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + rc = ESMF_SUCCESS + + !------------------ + ! the NUOPC model component mediator_routine_SS will register the generic methods + !------------------ + + call NUOPC_CompDerive(gcomp, mediator_routine_SS, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! set entry point for methods that require specific implementation + ! Provide InitializeP0 to switch from default IPDv00 to IPDv03 + !------------------ + + call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + InitializeP0, phase=0, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! IPDv03p1: advertise Fields + !------------------ + + ! Mediator advertises its import and export Fields and sets the TransferOfferGeomObject Attribute. + ! The TransferOfferGeomObject is a String value indicating a component's + ! intention to transfer the underlying Grid or Mesh on which an advertised Field object is defined. + ! The valid values are: [will provide, can provide, cannot provide] + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv03p1"/), userRoutine=InitializeIPDv03p1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! IPDv03p3: realize connected Fields with transfer action "provide" + !------------------ + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv03p3"/), userRoutine=InitializeIPDv03p3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! IPDv03p4: optionally modify the decomp/distr of transferred Grid/Mesh + !------------------ + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv03p4"/), userRoutine=InitializeIPDv03p4, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! IPDv03p5: realize all Fields with transfer action "accept" + !------------------ + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv03p5"/), userRoutine=InitializeIPDv03p5, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! attach specializing method for DataInitialize + !------------------ + + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_DataInitialize, & + specRoutine=DataInitialize, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! setup mediator history phase + !------------------ + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_history_write"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_history_write", specRoutine=med_phases_history_write, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! setup mediator restart phase + !------------------ + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_restart_write"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_restart_write", specRoutine=med_phases_restart_write, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! setup mediator profile phase + !------------------ + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_profile"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_profile", specRoutine=med_phases_profile, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! prep and post phases for connectors + !------------------ + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_connectors_prep_med2atm"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_connectors_prep_med2atm", specRoutine=med_connectors_prep_med2atm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_connectors_post_atm2med"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_connectors_post_atm2med", specRoutine=med_connectors_post_atm2med, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_connectors_prep_med2ocn"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_connectors_prep_med2ocn", specRoutine=med_connectors_prep_med2ocn, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_connectors_post_ocn2med"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_connectors_post_ocn2med", specRoutine=med_connectors_post_ocn2med, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_connectors_prep_med2ice"/), & + userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_connectors_prep_med2ice", specRoutine=med_connectors_prep_med2ice, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_connectors_post_ice2med"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_connectors_post_ice2med", specRoutine=med_connectors_post_ice2med, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_connectors_prep_med2lnd"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_connectors_prep_med2lnd", specRoutine=med_connectors_prep_med2lnd, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_connectors_post_lnd2med"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_connectors_post_lnd2med", specRoutine=med_connectors_post_lnd2med, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_connectors_prep_med2rof"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_connectors_prep_med2rof", specRoutine=med_connectors_prep_med2rof, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_connectors_post_rof2med"/), & + userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_connectors_post_rof2med", specRoutine=med_connectors_post_rof2med, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_connectors_prep_med2wav"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_connectors_prep_med2wav", specRoutine=med_connectors_prep_med2wav, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_connectors_post_wav2med"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_connectors_post_wav2med", specRoutine=med_connectors_post_wav2med, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_connectors_prep_med2glc"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_connectors_prep_med2glc", specRoutine=med_connectors_prep_med2glc, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_connectors_post_glc2med"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_connectors_post_glc2med", specRoutine=med_connectors_post_glc2med, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! prep routines for atm + !------------------ + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_prep_atm"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_prep_atm", specRoutine=med_phases_prep_atm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! prep routines for ocn + !------------------ + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_prep_ocn_map"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_prep_ocn_map", specRoutine=med_phases_prep_ocn_map, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_prep_ocn_merge"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_prep_ocn_merge", specRoutine=med_phases_prep_ocn_merge, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_prep_ocn_accum_fast"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_prep_ocn_accum_fast", specRoutine=med_phases_prep_ocn_accum_fast, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_prep_ocn_accum_avg"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_prep_ocn_accum_avg", specRoutine=med_phases_prep_ocn_accum_avg, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! prep routines for ice + !------------------ + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_prep_ice"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_prep_ice", specRoutine=med_phases_prep_ice, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! prep routines for lnd + !------------------ + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_prep_lnd"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_prep_lnd", specRoutine=med_phases_prep_lnd, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! prep routines for rof + !------------------ + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_prep_rof_avg"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_prep_rof_avg", specRoutine=med_phases_prep_rof_avg, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_prep_rof_accum_fast"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_prep_rof_accum_fast", specRoutine=med_phases_prep_rof_accum_fast, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! prep routines for wav + !------------------ + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_prep_wav"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_prep_wav", specRoutine=med_phases_prep_wav, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! prep routines for glc + !------------------ + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_prep_glc"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_prep_glc", specRoutine=med_phases_prep_glc, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! phase routine for ocean albedo computation + !------------------ + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_ocnalb_run"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_ocnalb_run", specRoutine=med_phases_ocnalb_run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! phase routine for ocn/atm flux computation + !------------------ + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_aofluxes_run"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_aofluxes_run", specRoutine=med_phases_aofluxes_run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! phase routine for updating fractions + !------------------ + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_fraction_set"/), userRoutine=mediator_routine_Run, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_fraction_set", specRoutine=med_fraction_set, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! attach specializing method(s) + ! -> NUOPC specializes by default --->>> first need to remove the default + !------------------ + + call ESMF_MethodRemove(gcomp, mediator_label_CheckImport, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_CheckImport, specRoutine=NUOPC_NoOp, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! attach specializing method(s) + ! -> NUOPC specializes by default --->>> first need to remove the default + !------------------ + + call ESMF_MethodRemove(gcomp, mediator_label_SetRunClock, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_SetRunClock, specRoutine=SetRunClock, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! attach specializing method(s) + ! -> NUOPC specializes by default --->>> first need to remove the default + !------------------ + + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Finalize, & + specRoutine=med_finalize, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine SetServices + + !----------------------------------------------------------------------------- + + subroutine InitializeP0(gcomp, importState, exportState, clock, rc) + use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_VM, ESMF_SUCCESS + use ESMF , only : ESMF_UtilString2Int, ESMF_GridCompGet, ESMF_VMGet, ESMF_AttributeGet + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_METHOD_INITIALIZE + use ESMF , only : ESMF_GridCompGet + use NUOPC , only : NUOPC_CompFilterPhaseMap + use med_internalstate_mod, only : mastertask + + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + type(ESMF_VM) :: vm + character(len=*),parameter :: subname='(module_MED:InitializeP0)' + character(len=128) :: value + integer :: dbrc + integer :: localPet + character(len=CX):: msgString + !----------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=localPet, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + mastertask = .false. + if (localPet == 0) mastertask=.true. + + call ESMF_AttributeGet(gcomp, name="Verbosity", value=value, defaultValue="max", & + convention="NUOPC", purpose="Instance", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": Mediator verbosity is "//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) + +! dbug_flag = ESMF_UtilString2Int(value, & +! specialStringList=(/"min","max","high"/), specialValueList=(/0,255,255/), rc=rc) +! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + write(msgString,'(A,i6)') trim(subname)//' dbug_flag = ',dbug_flag + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + + ! Switch to IPDv03 by filtering all other phaseMap entries + call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, acceptStringList=(/"IPDv03p"/), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + + end subroutine InitializeP0 + + !----------------------------------------------------------------------- + + subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) + + ! Mediator advertises its import and export Fields and sets the + ! TransferOfferGeomObject Attribute. + + use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_SUCCESS, ESMF_LogFoundAllocError + use ESMF , only : ESMF_LogMsg_Info, ESMF_LogWrite + use NUOPC , only : NUOPC_AddNamespace, NUOPC_Advertise + use med_constants_mod , only : CS + use med_internalstate_mod , only : InternalState + use shr_nuopc_scalars_mod , only : flds_scalar_name, flds_scalar_num + use esmFlds , only : ncomps, compmed, compatm, compocn + use esmFlds , only : compice, complnd, comprof, compwav, compglc, compname + use esmFlds , only : fldListFr, fldListTo + use esmFlds , only : shr_nuopc_fldList_GetNumFlds + use esmFlds , only : shr_nuopc_fldList_GetFldInfo + use esmFldsExchange_mod , only : esmFldsExchange + + ! input/output variables + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + character(len=CS) :: stdname, shortname + integer :: n, n1, n2, ncomp, nflds + character(len=CS) :: transferOffer + type(InternalState) :: is_local + integer :: dbrc + integer :: stat + character(len=*),parameter :: subname='(module_MED:InitializeIPDv03p1)' + !----------------------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + rc = ESMF_SUCCESS + + !------------------ + ! Allocate memory for the internal state and set it in the Component. + !------------------ + + allocate(is_local%wrap, stat=stat) + if (ESMF_LogFoundAllocError(statusToCheck=stat, & + msg="Allocation of the internal state memory failed.", line=__LINE__, file=u_FILE_u)) then + return ! bail out + end if + + call ESMF_GridCompSetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! add a namespace (i.e. nested state) for each import and export component state in the mediator's InternalState + !------------------ + + ! Namespaces are implemented via nested states. This creates a nested state inside of + ! state. The nested state is returned as nestedState. nestedStateName will be used to name the + ! newly created nested state. + + call NUOPC_AddNamespace(importState, namespace="ATM", nestedStateName="NestedState-AtmImp", & + nestedState=is_local%wrap%NStateImp(compatm), rc=rc) + call NUOPC_AddNamespace(importState, namespace="OCN", nestedStateName="NestedState-OcnImp", & + nestedState=is_local%wrap%NStateImp(compocn), rc=rc) + call NUOPC_AddNamespace(importState, namespace="ICE", nestedStateName="NestedState-IceImp", & + nestedState=is_local%wrap%NStateImp(compice), rc=rc) + call NUOPC_AddNamespace(importState, namespace="LND", nestedStateName="NestedState-LndImp", & + nestedState=is_local%wrap%NStateImp(complnd), rc=rc) + call NUOPC_AddNamespace(importState, namespace="ROF", nestedStateName="NestedState-RofImp", & + nestedState=is_local%wrap%NStateImp(comprof), rc=rc) + call NUOPC_AddNamespace(importState, namespace="WAV", nestedStateName="NestedState-WavImp", & + nestedState=is_local%wrap%NStateImp(compwav), rc=rc) + call NUOPC_AddNamespace(importState, namespace="GLC", nestedStateName="NestedState-GlcImp", & + nestedState=is_local%wrap%NStateImp(compglc), rc=rc) + call NUOPC_AddNamespace(exportState, namespace="ATM", nestedStateName="NestedState-AtmExp", & + nestedState=is_local%wrap%NStateExp(compatm), rc=rc) + call NUOPC_AddNamespace(exportState, namespace="OCN", nestedStateName="NestedState-OcnExp", & + nestedState=is_local%wrap%NStateExp(compocn), rc=rc) + call NUOPC_AddNamespace(exportState, namespace="ICE", nestedStateName="NestedState-IceExp", & + nestedState=is_local%wrap%NStateExp(compice), rc=rc) + call NUOPC_AddNamespace(exportState, namespace="LND", nestedStateName="NestedState-LndExp", & + nestedState=is_local%wrap%NStateExp(complnd), rc=rc) + call NUOPC_AddNamespace(exportState, namespace="ROF", nestedStateName="NestedState-RofExp", & + nestedState=is_local%wrap%NStateExp(comprof), rc=rc) + call NUOPC_AddNamespace(exportState, namespace="WAV", nestedStateName="NestedState-WavExp", & + nestedState=is_local%wrap%NStateExp(compwav), rc=rc) + call NUOPC_AddNamespace(exportState, namespace="GLC", nestedStateName="NestedState-GlcExp", & + nestedState=is_local%wrap%NStateExp(compglc), rc=rc) + + !------------------ + ! Initialize mediator flds (should be identical to the list in esmDict_Init) + !------------------ + + call esmFldsExchange(gcomp, phase='advertise', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! Advertise import/export mediator field names + !------------------ + + do ncomp = 1,ncomps + if (ncomp /= compmed) then + nflds = shr_nuopc_fldList_GetNumFlds(fldListFr(ncomp)) + do n = 1,nflds + call shr_nuopc_fldList_GetFldInfo(fldListFr(ncomp), n, stdname, shortname) + if (trim(shortname) == flds_scalar_name) then + transferOffer = 'will provide' + else + transferOffer = 'cannot provide' + end if + call NUOPC_Advertise(is_local%wrap%NStateImp(ncomp), standardName=stdname, shortname=shortname, name=shortname, & + TransferOfferGeomObject=transferOffer) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//':Fr_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + nflds = shr_nuopc_fldList_GetNumFlds(fldListTo(ncomp)) + do n = 1,nflds + call shr_nuopc_fldList_GetFldInfo(fldListTo(ncomp), n, stdname, shortname) + if (trim(shortname) == flds_scalar_name) then + transferOffer = 'will provide' + else + transferOffer = 'cannot provide' + end if + call NUOPC_Advertise(is_local%wrap%NStateExp(ncomp), standardName=stdname, shortname=shortname, name=shortname, & + TransferOfferGeomObject=transferOffer) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//':To_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end do + end if + end do ! end of ncomps loop + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + + end subroutine InitializeIPDv03p1 + + !----------------------------------------------------------------------------- + + subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) + + ! Realize connected Fields with transfer action "provide" + + use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_VM, ESMF_SUCCESS + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_TimeInterval + use ESMF , only : ESMF_VMGet, ESMF_StateIsCreated, ESMF_GridCompGet + use med_constants_mod , only : CL, R8 + use med_internalstate_mod , only : InternalState + use esmFlds , only : ncomps, compname + use esmFlds , only : fldListFr, fldListTo + use esmFlds , only : shr_nuopc_fldList_Realize + use shr_nuopc_scalars_mod , only : flds_scalar_name, flds_scalar_num + + ! Input/output variables + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + integer :: i, j + real(kind=R8),pointer :: lonPtr(:), latPtr(:) + type(InternalState) :: is_local + real(R8) :: intervalSec + type(ESMF_TimeInterval) :: timeStep + ! tcx XGrid + ! type(ESMF_Field) :: fieldX, fieldA, fieldO + ! type(ESMF_XGrid) :: xgrid + type(ESMF_VM) :: vm + integer :: n, n1, n2 + character(CL) :: cvalue + logical :: connected + integer :: dbrc + integer :: stat + character(len=*),parameter :: subname='(module_MED:InitializeIPDv03p3)' + !----------------------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + rc = ESMF_SUCCESS + + ! Get the internal state from Component. + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Initialize the internal state members + is_local%wrap%vm = vm + + ! Realize States + do n = 1,ncomps + if (ESMF_StateIsCreated(is_local%wrap%NStateImp(n), rc=rc)) then + call shr_nuopc_fldList_Realize(is_local%wrap%NStateImp(n), fldListFr(n), flds_scalar_name, flds_scalar_num, & + tag=subname//':Fr_'//trim(compname(n)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + if (ESMF_StateIsCreated(is_local%wrap%NStateExp(n), rc=rc)) then + call shr_nuopc_fldList_Realize(is_local%wrap%NStateExp(n), fldListTo(n), flds_scalar_name, flds_scalar_num, & + tag=subname//':To_'//trim(compname(n)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + enddo + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + + end subroutine InitializeIPDv03p3 + + !----------------------------------------------------------------------------- + + subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) + + ! Optionally modify the decomp/distr of transferred Grid/Mesh + + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_GRIDCOMP, ESMF_CLOCK, ESMF_STATE + use ESMF , only : ESMF_StateIsCreated + use med_internalstate_mod , only : InternalState + use med_constants_mod , only : CL + use esmFlds , only : ncomps, compname + + ! input/output variables + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: n1,n2 + ! type(ESMF_Field) :: field + ! type(ESMF_Grid) :: grid + ! integer :: localDeCount + ! type(ESMF_DistGrid) :: distgrid + ! integer :: dimCount, tileCount, petCount + ! integer :: deCountPTile, extraDEs + ! integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) + ! integer, allocatable :: regDecompPTile(:,:) + ! integer :: i, j, n, n1 + integer :: dbrc + character(len=*),parameter :: subname='(module_MED:realizeConnectedGrid)' + !----------------------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + rc = ESMF_SUCCESS + + ! Get the internal state from the mediator gridded component. + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! Recieve Grids + !------------------ + + do n1 = 1,ncomps + call ESMF_LogWrite(trim(subname)//": calling for component "//trim(compname(n1)), ESMF_LOGMSG_INFO, rc=dbrc) + if (ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then + call realizeConnectedGrid(is_local%wrap%NStateImp(n1), trim(compname(n1))//'Imp', rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + if (ESMF_StateIsCreated(is_local%wrap%NStateExp(n1),rc=rc)) then + call realizeConnectedGrid(is_local%wrap%NStateExp(n1), trim(compname(n1))//'Exp', rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + call ESMF_LogWrite(trim(subname)//": finished for component "//trim(compname(n1)), ESMF_LOGMSG_INFO, rc=dbrc) + enddo + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + + contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + subroutine realizeConnectedGrid(State,string,rc) + + use ESMF , only : operator(==) + use ESMF , only : ESMF_STATE, ESMF_Field, ESMF_Grid, ESMF_DistGrid, ESMF_DistGridConnection + use ESMF , only : ESMF_MAXSTR, ESMF_FieldStatus_Flag, ESMF_GeomType_Flag, ESMF_StateGet + use ESMF , only : ESMF_FieldGet, ESMF_DistGridGet, ESMF_GridCompGet + use ESMF , only : ESMF_GeomType_Grid, ESMF_AttributeGet, ESMF_DistGridCreate, ESMF_FieldEmptySet + use ESMF , only : ESMF_GridCreate, ESMF_LogWrite, ESMF_LogMsg_Info, ESMF_GridGet, ESMF_Failure + use ESMF , only : ESMF_LogMsg_Warning + use ESMF , only : ESMF_FieldStatus_Empty, ESMF_FieldStatus_Complete, ESMF_FieldStatus_GridSet + use ESMF , only : ESMF_GeomType_Mesh, ESMF_MeshGet, ESMF_Mesh, ESMF_MeshEmptyCreate + use shr_nuopc_methods_mod , only: shr_nuopc_methods_Field_GeomPrint + + type(ESMF_State) , intent(inout) :: State + character(len=*) , intent(in) :: string + integer , intent(out) :: rc + + ! local variables + type(ESMF_Field) :: field + type(ESMF_Grid) :: grid + type(ESMF_Mesh) :: mesh, newmesh + integer :: localDeCount + + type(ESMF_DistGrid) :: distgrid + type(ESMF_DistGrid) :: nodaldistgrid, newnodaldistgrid + type(ESMF_DistGrid) :: elemdistgrid, newelemdistgrid + type(ESMF_DistGridConnection), allocatable :: connectionList(:) + integer :: arbDimCount + integer :: dimCount, tileCount, petCount + integer :: connectionCount + integer :: deCountPTile, extraDEs + integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) + integer, allocatable :: regDecompPTile(:,:) + integer :: i, j, n, n1, fieldCount, nxg, i1, i2 + type(ESMF_GeomType_Flag) :: geomtype + character(ESMF_MAXSTR),allocatable :: fieldNameList(:) + type(ESMF_FieldStatus_Flag) :: fieldStatus + integer :: dbrc + character(len=CX) :: msgString + character(len=*),parameter :: subname='(module_MEDIATOR:realizeConnectedGrid)' + + + !NOTE: All of the Fields that set their TransferOfferGeomObject Attribute + !NOTE: to "cannot provide" should now have the accepted Grid available. + !NOTE: Go and pull out this Grid for one of a representative Field and + !NOTE: modify the decomposition and distribution of the Grid to match the + !NOTE: Mediator PETs. + + !TODO: quick implementation, do it for each field one by one + !TODO: commented out below are application to other fields + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + rc = ESMF_Success + + call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + allocate(fieldNameList(fieldCount)) + call ESMF_StateGet(State, itemNameList=fieldNameList, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_GridCompGet(gcomp, petCount=petCount, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! do not loop here, assuming that all fields share the + ! same grid/mesh and because it is more efficient - if + ! a component has fields on multiple grids/meshes, this + ! would need to be revisited + do n=1, min(fieldCount, 1) + + call ESMF_StateGet(State, field=field, itemName=fieldNameList(n), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(field, status=fieldStatus, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !call NUOPC_GetAttribute(field, name="TransferActionGeomObject", & + ! value=transferAction, rc=rc) + !if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (fieldStatus==ESMF_FIELDSTATUS_GRIDSET) then + + ! The Mediator is accepting a Grid/Mesh passed to it + ! through the Connector + + ! While this is still an empty field, it does now hold a Grid/Mesh with DistGrid + call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (geomtype == ESMF_GEOMTYPE_GRID) then + + !if (dbug_flag > 1) then + ! call shr_nuopc_methods_Field_GeomPrint(field,trim(fieldNameList(n))//'_orig',rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + !end if + + call ESMF_AttributeGet(field, name="ArbDimCount", value=arbDimCount, & + convention="NUOPC", purpose="Instance", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": geomtype is ESMF_GEOMTYPE_GRID for "//trim(fieldnameList(n)), & + ESMF_LOGMSG_INFO, rc=dbrc) + write(msgString,'(A,i8)') trim(subname)//':arbdimcount =',arbdimcount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=dbrc) + + ! make decision on whether the incoming Grid is arbDistr or not + if (arbDimCount>0) then + ! The provider defined an arbDistr grid + ! + ! Need to make a choice here to either represent the grid as a + ! regDecomp grid on the acceptor side, or to stay with arbDistr grid: + ! + ! Setting the PRECIP_REGDECOMP macro will set up a regDecomp grid on the + ! acceptor side. + ! + ! Not setting the PRECIP_REGDECOMP macro will default into keeping the + ! original arbDistr Grid. + + if (grid_arbopt == "grid_reg") then + + call ESMF_LogWrite(trim(subname)//trim(string)//": accept arb2reg grid for "//trim(fieldNameList(n)), & + ESMF_LOGMSG_INFO, rc=dbrc) + + ! Use a regDecomp representation for the grid + ! first get tile min/max, only single tile supported for arbDistr Grid + allocate(minIndexPTile(arbDimCount,1),maxIndexPTile(arbDimCount,1)) + call ESMF_AttributeGet(field, name="MinIndex", & + valueList=minIndexPTile(:,1), & + convention="NUOPC", purpose="Instance", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_AttributeGet(field, name="MaxIndex", & + valueList=maxIndexPTile(:,1), & + convention="NUOPC", purpose="Instance", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create default regDecomp DistGrid + distgrid = ESMF_DistGridCreate(minIndexPTile=minIndexPTile, & + maxIndexPTile=maxIndexPTile, connectionList=connectionList, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create default regDecomp Grid + grid = ESMF_GridCreate(distgrid, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! swap out the transferred grid for the newly created one + call ESMF_FieldEmptySet(field, grid=grid, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + do i1 = 1,arbDimCount + write(msgString,'(A,3i8)') trim(subname)//':PTile =',i1,minIndexPTile(i1,1),maxIndexPTile(i1,1) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + enddo + deallocate(minIndexPTile,maxIndexPTile) + + elseif (grid_arbopt == "grid_arb") then + + ! Stick with the arbDistr representation of the grid: + ! There is nothing to do here if the same number of DEs is kept on the + ! acceptor side. Alternatively, the acceptor side could set up a more + ! natural number of DEs (maybe same number as acceptor PETs), and then + ! redistribute the arbSeqIndexList. Here simply keep the DEs of the + ! provider Grid. + call ESMF_LogWrite(trim(subname)//trim(string)//": accept arb2arb grid for "//trim(fieldNameList(n)), & + ESMF_LOGMSG_INFO, rc=dbrc) + + else ! grid_arbopt + + call ESMF_LogWrite(trim(subname)//trim(string)//": ERROR grid_arbopt setting = "//trim(grid_arbopt), & + ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + endif ! grid_arbopt + + + else ! arbdimcount <= 0 + + ! The provider defined as non arb grid + + ! access localDeCount to show this is a real Grid + call ESMF_LogWrite(trim(subname)//trim(string)//": accept reg2reg grid for "//& + trim(fieldNameList(n)), ESMF_LOGMSG_INFO, rc=dbrc) + + call ESMF_FieldGet(field, grid=grid, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_GridGet(grid, localDeCount=localDeCount, distgrid=distgrid, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create a custom DistGrid, based on the minIndex, maxIndex of the + ! accepted DistGrid, but with a default regDecomp for the current VM + ! that leads to 1DE/PET. + + ! get dimCount and tileCount + call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, & + connectionCount=connectionCount, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! allocate minIndexPTile and maxIndexPTile accord. to dimCount and tileCount + allocate(minIndexPTile(dimCount, tileCount), maxIndexPTile(dimCount, tileCount)) + allocate(connectionList(connectionCount)) + + ! get minIndex and maxIndex arrays, and connectionList + call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & + maxIndexPTile=maxIndexPTile, connectionList=connectionList, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! construct a default regDecompPTile -> TODO: move this into ESMF as default + + allocate(regDecompPTile(dimCount, tileCount)) + deCountPTile = petCount/tileCount + extraDEs = max(0, petCount-deCountPTile) + do i=1, tileCount + if (i<=extraDEs) then + regDecompPTile(1, i) = deCountPTile + 1 + else + regDecompPTile(1, i) = deCountPTile + endif + do j=2, dimCount + regDecompPTile(j, i) = 1 + enddo + enddo + + do i2 = 1,tileCount + do i1 = 1,dimCount + write(msgString,'(A,5i8)') trim(subname)//':PTile =',i2,i1,minIndexPTile(i1,i2),& + maxIndexPTile(i1,i2),regDecompPTile(i1,i2) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + enddo + enddo + + !--- tcraig, hardwire i direction wraparound, temporary + !--- tcraig, now getting info from model distgrid, see above + ! allocate(connectionList(1)) + ! nxg = maxIndexPTile(1,1) - minIndexPTile(1,1) + 1 + ! write(msgstring,*) trim(subname)//trim(string),': connlist nxg = ',nxg + ! call ESMF_LogWrite(trim(msgstring), ESMF_LOGMSG_INFO, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & + ! tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create the new DistGrid with the same minIndexPTile and maxIndexPTile, + ! but with a default regDecompPTile + ! tcraig, force connectionlist and gridEdge arguments to fix wraparound + ! need ESMF fixes to implement properly. + if (dimcount == 2) then + distgrid = ESMF_DistGridCreate(minIndexPTile=minIndexPTile, & + maxIndexPTile=maxIndexPTile, regDecompPTile=regDecompPTile, & + connectionList=connectionList, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//trim(string)//': distgrid with dimcount=2', ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create a new Grid on the new DistGrid and swap it in the Field + grid = ESMF_GridCreate(distgrid, gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else + distgrid = ESMF_DistGridCreate(minIndexPTile=minIndexPTile, & + maxIndexPTile=maxIndexPTile, regDecompPTile=regDecompPTile, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//trim(string)//': distgrid with dimcount=1', ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create a new Grid on the new DistGrid and swap it in the Field + grid = ESMF_GridCreate(distgrid, gridEdgeLWidth=(/0/), gridEdgeUWidth=(/0/), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + ! local clean-up + deallocate(connectionList) + deallocate(minIndexPTile, maxIndexPTile, regDecompPTile) + + endif ! arbdimCount + + ! Swap all the Grids in the State + do n1=1, fieldCount + ! access a field in the State and set the Grid + call ESMF_StateGet(State, field=field, itemName=fieldNameList(n1), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(field, status=fieldStatus, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (fieldStatus==ESMF_FIELDSTATUS_EMPTY .or. fieldStatus==ESMF_FIELDSTATUS_GRIDSET) then + call ESMF_FieldEmptySet(field, grid=grid, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//trim(string)//": attach grid for "//trim(fieldNameList(n1)), & + ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 1) then + call shr_nuopc_methods_Field_GeomPrint(field,trim(fieldNameList(n1))//'_new',rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + else + call ESMF_LogWrite(trim(subname)//trim(string)//": NOT replacing grid for field: "//& + trim(fieldNameList(n1)), ESMF_LOGMSG_WARNING, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + enddo + + + elseif (geomtype == ESMF_GEOMTYPE_MESH) then + + call ESMF_LogWrite(trim(subname)//": geomtype is ESMF_GEOMTYPE_MESH for "//trim(fieldnameList(n)), & + ESMF_LOGMSG_INFO, rc=dbrc) + + if (dbug_flag > 1) then + call shr_nuopc_methods_Field_GeomPrint(field,trim(fieldNameList(n))//'_orig',rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + call ESMF_FieldGet(field, mesh=mesh, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(mesh, elementDistGrid=elemDistGrid, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + newelemDistGrid = ESMF_DistGridCreate(elemDistGrid, balanceflag=.true., rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! call ESMF_MeshGet(mesh, nodalDistGrid=nodalDistGrid, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! newnodalDistGrid = ESMF_DistGridCreate(nodalDistGrid, balanceflag=.true., rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create a new Grid on the new DistGrid and swap it in the Field + ! newmesh = ESMF_MeshEmptyCreate(elementDistGrid=newelemDistGrid, nodalDistGrid=newnodalDistGrid, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + newmesh = ESMF_MeshEmptyCreate(elementDistGrid=newelemDistGrid, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Swap all the Meshes in the State + do n1=1, fieldCount + ! access a field in the State and set the Mesh + call ESMF_StateGet(State, field=field, itemName=fieldNameList(n1), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(field, status=fieldStatus, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (fieldStatus==ESMF_FIELDSTATUS_EMPTY .or. fieldStatus==ESMF_FIELDSTATUS_GRIDSET) then + call ESMF_FieldEmptySet(field, mesh=newmesh, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//trim(string)//": attach mesh for "//& + trim(fieldNameList(n1)), ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 1) then + call shr_nuopc_methods_Field_GeomPrint(field,trim(fieldNameList(n1))//'_new',rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + else + call ESMF_LogWrite(trim(subname)//trim(string)//": NOT replacing mesh for field: "//& + trim(fieldNameList(n1)), ESMF_LOGMSG_WARNING, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + enddo + + else ! geomtype + + call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", ESMF_LOGMSG_INFO, rc=rc) + rc=ESMF_FAILURE + return + + endif ! geomtype + + elseif (fieldStatus==ESMF_FIELDSTATUS_EMPTY) then + + call ESMF_LogWrite(trim(subname)//trim(string)//": provide grid for "//trim(fieldNameList(n)), & + ESMF_LOGMSG_INFO, rc=dbrc) + + elseif (fieldStatus==ESMF_FIELDSTATUS_COMPLETE) then + + call ESMF_LogWrite(trim(subname)//trim(string)//": no grid provided for "//trim(fieldNameList(n)), & + ESMF_LOGMSG_INFO, rc=dbrc) + + else + + call ESMF_LogWrite(trim(subname)//": ERROR fieldStatus not supported ", ESMF_LOGMSG_INFO, rc=rc) + rc=ESMF_FAILURE + return + + endif ! fieldStatus + + enddo ! nflds + + deallocate(fieldNameList) + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + + end subroutine realizeConnectedGrid + + end subroutine InitializeIPDv03p4 + + !----------------------------------------------------------------------------- + + subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) + + use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_LogWrite + use ESMF , only : ESMF_SUCCESS, ESMF_LOGMSG_INFO, ESMF_StateIsCreated + use med_internalstate_mod , only: InternalState + use esmFlds , only: ncomps, compname + use shr_nuopc_methods_mod , only: shr_nuopc_methods_State_reset + use shr_nuopc_methods_mod , only: shr_nuopc_methods_State_GeomPrint + use shr_nuopc_methods_mod , only: shr_nuopc_methods_State_GeomWrite + + !---------------------------------------------------------- + ! realize all Fields with transfer action "accept" + !---------------------------------------------------------- + + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: n1,n2 + character(len=*),parameter :: subname='(module_MED:InitializeIPDv03p5)' + integer :: dbrc + !----------------------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + + rc = ESMF_SUCCESS + + ! Get the internal state from Component. + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--- Finish initializing the State Fields + !--- Write out grid information + + do n1 = 1,ncomps + + if (ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then + call ESMF_LogWrite(trim(subname)//": calling completeFieldInitialize import states from "//trim(compname(n1)), & + ESMF_LOGMSG_INFO, rc=dbrc) + call completeFieldInitialization(is_local%wrap%NStateImp(n1), rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_State_reset(is_local%wrap%NStateImp(n1), value=spval_init, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + if (ESMF_StateIsCreated(is_local%wrap%NStateExp(n1),rc=rc)) then + call ESMF_LogWrite(trim(subname)//": calling completeFieldInitialize export states to "//trim(compname(n1)), & + ESMF_LOGMSG_INFO, rc=dbrc) + call completeFieldInitialization(is_local%wrap%NStateExp(n1), rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_State_reset(is_local%wrap%NStateExp(n1), value=spval_init, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 1) then + call shr_nuopc_methods_State_GeomPrint(is_local%wrap%NStateExp(n1),'gridExp'//trim(compname(n1)),rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_State_GeomWrite(is_local%wrap%NStateExp(n1), 'grid_med_'//trim(compname(n1)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + endif + enddo + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + + contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + subroutine completeFieldInitialization(State,rc) + + use ESMF , only : operator(==) + use ESMF , only : ESMF_State, ESMF_MAXSTR, ESMF_Grid, ESMF_Mesh, ESMF_Field, ESMF_FieldStatus_Flag + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FieldGet, ESMF_FieldEmptyComplete + use ESMF , only : ESMF_GeomType_Flag, ESMF_FieldCreate, ESMF_GridToMeshCell, ESMF_GEOMTYPE_GRID + use ESMF , only : ESMF_MeshLoc_Element, ESMF_TYPEKIND_R8, ESMF_FIELDSTATUS_GRIDSET + use NUOPC , only : NUOPC_getStateMemberLists, NUOPC_Realize + use shr_nuopc_scalars_mod , only : flds_scalar_name, flds_scalar_num + use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_getNumFields + use shr_nuopc_methods_mod , only : shr_nuopc_methods_Field_GeomPrint + + ! input/output variables + type(ESMF_State) , intent(inout) :: State + integer , intent(out) :: rc + + ! local varaibles + integer :: n, fieldCount + character(ESMF_MAXSTR) :: fieldName + type(ESMF_Grid) :: grid + type(ESMF_Mesh) :: mesh + type(ESMF_Field) :: meshField + type(ESMF_Field),pointer :: fieldList(:) + type(ESMF_FieldStatus_Flag) :: fieldStatus + type(ESMF_GeomType_Flag) :: geomtype + character(len=*),parameter :: subname='(module_MED:completeFieldInitialization)' + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + rc = ESMF_Success + + call shr_nuopc_methods_State_GetNumFields(State, fieldCount, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (fieldCount > 0) then + nullify(fieldList) + call NUOPC_getStateMemberLists(State, fieldList=fieldList, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + do n=1, fieldCount + + call ESMF_FieldGet(fieldList(n), status=fieldStatus, name=fieldName, & + geomtype=geomtype, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (geomtype == ESMF_GEOMTYPE_GRID .and. fieldName /= flds_scalar_name) then + ! Grab grid + if (dbug_flag > 1) then + call shr_nuopc_methods_Field_GeomPrint(fieldList(n),trim(fieldName)//'_premesh',rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_FieldGet(fieldList(n), grid=grid, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Convert grid to mesh + mesh = ESMF_GridToMeshCell(grid,rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + meshField = ESMF_FieldCreate(mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, name=fieldName, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Swap grid for mesh, at this point, only connected fields are in the state + call NUOPC_Realize(State, field=meshField, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + if (fieldStatus==ESMF_FIELDSTATUS_GRIDSET) then + call ESMF_LogWrite(subname//" is allocating field memory for field "//trim(fieldName), & + ESMF_LOGMSG_INFO, rc=rc) + call ESMF_FieldEmptyComplete(fieldList(n), typekind=ESMF_TYPEKIND_R8, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif ! fieldStatus + + if (dbug_flag > 1) then + call shr_nuopc_methods_Field_GeomPrint(fieldList(n), trim(subname)//':'//trim(fieldName), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + enddo + deallocate(fieldList) + endif + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + + end subroutine completeFieldInitialization + + end subroutine InitializeIPDv03p5 + + !----------------------------------------------------------------------------- + + subroutine DataInitialize(gcomp, rc) + !---------------------------------------------------------- + ! Finish initialization and resolve data dependencies + ! There will be multiple passes + ! For first time through: + ! Do not assume any import fields are connected, just allocate space and such + ! -- Check present flags + ! -- Check for active coupling interactions + ! -- Initialize connector count arrays in med_internal_state + ! -- Create FBs: FBImp, FBExp, FBExpAccum + ! -- Create mediator specific field bundles (not part of import/export states) + ! -- Initialize med_infodata, FBExpAccums (to zero), and FBImp (from NStateImp) + ! -- Read mediator restarts + ! -- Initialize route handles + ! -- Initialize field bundles for normalization + ! -- return! + ! For second loop: + ! -- Copy import fields to local FBs + ! -- Create FBfrac and initialize fractions + ! Once the ocean is ready: + ! -- Copy import fields to local FBs + ! -- Re-initialize fractions + ! -- Carry out ocnalb_init + ! -- Carry out aoffluxes_init + ! Once the atm is ready: + ! -- Copy import fields to local FBs + !---------------------------------------------------------- + + use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_LogWrite, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_State, ESMF_Time, ESMF_Field, ESMF_StateItem_Flag, ESMF_MAXSTR + use ESMF , only : ESMF_GridCompGet, ESMF_AttributeGet, ESMF_ClockGet, ESMF_Success + use ESMF , only : ESMF_StateIsCreated, ESMF_StateGet, ESMF_LogFlush + use NUOPC , only : NUOPC_CompAttributeSet, NUOPC_IsAtTime, NUOPC_SetAttribute + use NUOPC , only : NUOPC_CompAttributeGet + use med_internalstate_mod , only : InternalState + use med_internalstate_mod , only : med_coupling_allowed, logunit + use med_internalstate_mod , only : mastertask + use shr_sys_mod , only : shr_sys_flush + use esmFlds , only : ncomps, compname, ncomps, compmed, compatm, compocn + use esmFlds , only : compice, complnd, comprof, compwav, compglc, compname + use esmFlds , only : fldListMed_ocnalb, fldListMed_aoflux + use esmFlds , only : shr_nuopc_fldList_GetNumFlds + use esmFlds , only : shr_nuopc_fldList_GetFldNames + use esmFlds , only : shr_nuopc_fldList_Document_Mapping + use esmFlds , only : shr_nuopc_fldList_Document_Merging + use esmFldsExchange_mod , only : esmFldsExchange + use shr_nuopc_scalars_mod , only : flds_scalar_name, flds_scalar_num + use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_getNumFields + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_Init + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_Reset + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_Copy + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FldChk + use med_infodata_mod , only : med_infodata_CopyStateToInfodata + use med_infodata_mod , only : med_infodata + use med_fraction_mod , only : med_fraction_init, med_fraction_set + use med_phases_restart_mod , only : med_phases_restart_read + use med_phases_prep_atm_mod , only : med_phases_prep_atm + use med_phases_ocnalb_mod , only : med_phases_ocnalb_run + use med_phases_aofluxes_mod , only : med_phases_aofluxes_run + use med_phases_profile_mod , only : med_phases_profile + use med_connectors_mod , only : med_connectors_prep_med2atm + use med_connectors_mod , only : med_connectors_prep_med2ocn + use med_connectors_mod , only : med_connectors_prep_med2ice + use med_connectors_mod , only : med_connectors_prep_med2lnd + use med_connectors_mod , only : med_connectors_prep_med2rof + use med_connectors_mod , only : med_connectors_prep_med2wav + use med_connectors_mod , only : med_connectors_prep_med2glc + use med_connectors_mod , only : med_connectors_post_atm2med + use med_connectors_mod , only : med_connectors_post_ocn2med + use med_connectors_mod , only : med_connectors_post_ice2med + use med_connectors_mod , only : med_connectors_post_lnd2med + use med_connectors_mod , only : med_connectors_post_rof2med + use med_connectors_mod , only : med_connectors_post_wav2med + use med_connectors_mod , only : med_connectors_post_glc2med + use med_map_mod , only : med_map_MapNorm_init, med_map_RouteHandles_init + use med_io_mod , only : med_io_init + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + type(ESMF_Clock) :: clock + type(ESMF_State) :: importState, exportState + type(ESMF_Time) :: time + type(ESMF_Field) :: field + type(ESMF_StateItem_Flag) :: itemType + logical :: atCorrectTime, connected + integer :: n1,n2,n + integer :: cntn1, cntn2 + integer :: fieldCount + character(ESMF_MAXSTR),allocatable :: fieldNameList(:) + character(CL) :: value + character(CL), pointer :: fldnames(:) + character(CL) :: cvalue + character(CL) :: start_type + logical :: read_restart + logical :: LocalDone + logical,save :: atmDone = .false. + logical,save :: ocnDone = .false. + logical,save :: allDone = .false. + logical,save :: first_call = .true. + integer :: dbrc + character(len=CX) :: msgString + character(len=*), parameter :: subname='(module_MED:DataInitialize)' + !----------------------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + rc = ESMF_SUCCESS + + call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! query the Component for its clock, importState and exportState + call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, exportState=exportState, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Get the internal state from Component. + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! get the current time out of the clock + call ESMF_ClockGet(clock, currTime=time, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + ! Beginning of first_call block + !--------------------------------------- + + if (first_call) then + + ! initialize the present flags in the mediator + call ESMF_LogWrite("Starting to initialize present flags", ESMF_LOGMSG_INFO) + call ESMF_LogFlush() + + !---------------------------------------------------------- + !--- Check present flags + !---------------------------------------------------------- + + do n1 = 1,ncomps + call ESMF_AttributeGet(gcomp, name=trim(compname(n1))//"_present", value=value, defaultValue="false", & + convention="NUOPC", purpose="Instance", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + is_local%wrap%comp_present(n1) = (value == "true") + write(msgString,'(A,L4)') trim(subname)//' comp_present(comp'//trim(compname(n1))//') = ',& + is_local%wrap%comp_present(n1) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + enddo + + !---------------------------------------------------------- + !--- Check for active coupling interactions + ! must be allowed, bundles created, and both sides have some fields + !---------------------------------------------------------- + + call ESMF_LogWrite("Starting to initialize active flags", ESMF_LOGMSG_INFO) + call ESMF_LogFlush() + + ! initialize med_coupling_active + is_local%wrap%med_coupling_active(:,:) = .false. + + do n1 = 1,ncomps + if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then + call shr_nuopc_methods_State_GetNumFields(is_local%wrap%NStateImp(n1), cntn1, rc=rc) ! Import Field Count + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (cntn1 > 0) then + do n2 = 1,ncomps + if (is_local%wrap%comp_present(n2) .and. & + ESMF_StateIsCreated(is_local%wrap%NStateExp(n2),rc=rc) .and. & + med_coupling_allowed(n1,n2)) then + call shr_nuopc_methods_State_GetNumFields(is_local%wrap%NStateExp(n2), cntn2, rc=rc) ! Import Field Count + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (cntn2 > 0) then + is_local%wrap%med_coupling_active(n1,n2) = .true. + endif + endif + enddo + end if + endif + enddo + + ! create tables of output + if (mastertask) then + if (dbug_flag > 5) then + write(logunit,*) ' ' + write(logunit,'(A)') subname//' Allowed coupling flags' + write(logunit,'(2x,A10,20(A5))') '|from to->',(compname(n2),n2=1,ncomps) + do n1 = 1,ncomps + write(msgString,'(2x,a1,A,5x,20(L5))') '|',trim(compname(n1)),(med_coupling_allowed(n1,n2),n2=1,ncomps) + do n2 = 1,len_trim(msgString) + if (msgString(n2:n2) == 'F') msgString(n2:n2)='-' + enddo + write(logunit,'(A)') trim(msgString) + enddo + write(logunit,*) ' ' + call shr_sys_flush(logunit) + endif + + if (dbug_flag >= 0) then + write(logunit,*) ' ' + write(logunit,'(A)') subname//' Active coupling flags' + write(logunit,'(2x,A10,20(A5))') '|from to->',(compname(n2),n2=1,ncomps) + do n1 = 1,ncomps + write(msgString,'(2x,a1,A,5x,20(L5))') '|',trim(compname(n1)),& + (is_local%wrap%med_coupling_active(n1,n2),n2=1,ncomps) + do n2 = 1,len_trim(msgString) + if (msgString(n2:n2) == 'F') msgString(n2:n2)='-' + enddo + write(logunit,'(A)') trim(msgString) + enddo + write(logunit,*) ' ' + call shr_sys_flush(logunit) + endif + endif + + !---------------------------------------------------------- + ! Initialize connector count + !---------------------------------------------------------- + + call ESMF_LogWrite("Starting to Create FBs", ESMF_LOGMSG_INFO) + call ESMF_LogFlush() + + is_local%wrap%conn_prep_cnt(:) = 0 + is_local%wrap%conn_post_cnt(:) = 0 + + !---------------------------------------------------------- + ! Create field bundles FBImp, FBExp, FBImpAccum, FBExpAccum + !---------------------------------------------------------- + + do n1 = 1,ncomps + if (is_local%wrap%comp_present(n1) .and. & + ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc) .and. & + ESMF_StateIsCreated(is_local%wrap%NStateExp(n1),rc=rc)) then + + if (mastertask) write(logunit,*) subname,' initializing FBs for '//trim(compname(n1)) + + call shr_nuopc_methods_FB_init(is_local%wrap%FBImp(n1,n1), flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(n1), & + STflds=is_local%wrap%NStateImp(n1), & + name='FBImp'//trim(compname(n1)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_init(is_local%wrap%FBImpAccum(n1,n1), flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(n1), & + STflds=is_local%wrap%NStateImp(n1), & + name='FBImp'//trim(compname(n1)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_reset(is_local%wrap%FBImpAccum(n1,n1), value=czero, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + is_local%wrap%FBImpAccumCnt(n1) = 0 + + call shr_nuopc_methods_FB_init(is_local%wrap%FBExp(n1), flds_scalar_name, & + STgeom=is_local%wrap%NStateExp(n1), & + STflds=is_local%wrap%NStateExp(n1), & + name='FBExp'//trim(compname(n1)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_init(is_local%wrap%FBExpAccum(n1), flds_scalar_name, & + STgeom=is_local%wrap%NStateExp(n1), & + STflds=is_local%wrap%NStateExp(n1), & + name='FBExpAccum'//trim(compname(n1)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_reset(is_local%wrap%FBExpAccum(n1), value=czero, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + is_local%wrap%FBExpAccumCnt(n1) = 0 + + endif + if (mastertask) call shr_sys_flush(logunit) + + ! The following are FBImp and FBImpAccum mapped to different grids. + ! FBImp(n1,n1) and FBImpAccum(n1,n1) are handled above + + do n2 = 1,ncomps + if (n1 /= n2 .and. & + is_local%wrap%med_coupling_active(n1,n2) .and. & + ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc) .and. & + ESMF_StateIsCreated(is_local%wrap%NStateExp(n2),rc=rc)) then + + if (mastertask) write(logunit,*) subname,' initializing FBs for '//& + trim(compname(n1))//'_'//trim(compname(n2)) + + call shr_nuopc_methods_FB_init(is_local%wrap%FBImp(n1,n2), flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(n2), & + STflds=is_local%wrap%NStateImp(n1), & + name='FBImp'//trim(compname(n1))//'_'//trim(compname(n2)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_init(is_local%wrap%FBImpAccum(n1,n2), flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(n2), & + STflds=is_local%wrap%NStateImp(n1), & + name='FBImpAccum'//trim(compname(n1))//'_'//trim(compname(n2)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_reset(is_local%wrap%FBImpAccum(n1,n2), value=czero, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + endif + enddo ! loop over n2 + + enddo ! loop over n1 + if (mastertask) call shr_sys_flush(logunit) + + !--------------------------------------- + ! Initialize field bundles needed for ocn albedo and ocn/atm flux calculations + !--------------------------------------- + + if ( is_local%wrap%med_coupling_active(compocn,compatm) .or. & + is_local%wrap%med_coupling_active(compatm,compocn)) then + + ! NOTE: the NStateImp(compocn) or NStateImp(compatm) used below + ! rather than NStateExp(n2), since the export state might only + ! contain control data and no grid information if if the target + ! component (n2) is not prognostic only receives control data back + + ! NOTE: this section must be done BEFORE the call to esmFldsExchange + ! Create field bundles for mediator ocean albedo computation + + fieldCount = shr_nuopc_fldList_GetNumFlds(fldListMed_ocnalb) + if (fieldCount > 0) then + allocate(fldnames(fieldCount)) + call shr_nuopc_fldList_getfldnames(fldListMed_ocnalb%flds, fldnames, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_init(is_local%wrap%FBMed_ocnalb_a, flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compatm), fieldnamelist=fldnames, name='FBMed_ocnalb_a', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_init(is_local%wrap%FBMed_ocnalb_o, flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compocn), fieldnamelist=fldnames, name='FBMed_ocnalb_o', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(fldnames) + end if + + ! Create field bundles for mediator ocean/atmosphere flux computation + + fieldCount = shr_nuopc_fldList_GetNumFlds(fldListMed_aoflux) + if (fieldCount > 0) then + allocate(fldnames(fieldCount)) + call shr_nuopc_fldList_getfldnames(fldListMed_aoflux%flds, fldnames, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_init(is_local%wrap%FBMed_aoflux_a, flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compatm), fieldnamelist=fldnames, name='FBMed_aoflux_a', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_init(is_local%wrap%FBMed_aoflux_o, flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compocn), fieldnamelist=fldnames, name='FBMed_aoflux_o', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(fldnames) + end if + end if + + !--------------------------------------- + ! Determine mapping and merging info for field exchanges in mediator + !--------------------------------------- + + call esmFldsExchange(gcomp, phase='initialize', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (mastertask) then + call shr_nuopc_fldList_Document_Mapping(logunit, is_local%wrap%med_coupling_active) + call shr_nuopc_fldList_Document_Merging(logunit, is_local%wrap%med_coupling_active) + end if + + !--------------------------------------- + ! Initialize route handles and required normalization field bunds + !--------------------------------------- + + call med_map_RouteHandles_init(gcomp, logunit, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call med_map_MapNorm_init(gcomp, logunit, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + first_call = .false. + + call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + return + + endif ! end first_call if-block + + !--------------------------------------- + ! Initialize mediator fields and infodata + ! This is called every loop around DataInitialize + !--------------------------------------- + + do n1 = 1,ncomps + LocalDone = .true. + if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then + + call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemCount=fieldCount, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + allocate(fieldNameList(fieldCount)) + call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemNameList=fieldNameList, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + do n=1, fieldCount + call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemName=fieldNameList(n), field=field, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + atCorrectTime = NUOPC_IsAtTime(field, time, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (atCorrectTime) then + if (fieldNameList(n) == flds_scalar_name) then + call med_infodata_CopyStateToInfodata(is_local%wrap%NStateImp(n1), med_infodata, & + trim(compname(n1))//'2cpli', is_local%wrap%vm, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//" MED - Initialize-Data-Dependency CSTI "//trim(compname(n1)), & + ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + else + LocalDone=.false. + endif + enddo + deallocate(fieldNameList) + + if (LocalDone) then + call shr_nuopc_methods_FB_copy(is_local%wrap%FBImp(n1,n1), is_local%wrap%NStateImp(n1), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//" MED - Initialize-Data-Dependency Copy Import "//trim(compname(n1)), ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (n1 == compocn) ocnDone = .true. + if (n1 == compatm) atmDone = .true. + endif + endif + enddo + + !---------------------------------------------------------- + ! Create FBfrac field bundles and initialize fractions + ! This has some complex dependencies on fractions from import States + ! and appropriate checks are not implemented. We might need to split + ! out the fraction FB allocation and the fraction initialization + !---------------------------------------------------------- + + call med_fraction_init(gcomp,rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call med_fraction_set(gcomp,rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + ! Carry out data dependency for atm initialization if needed + !--------------------------------------- + + if (.not. is_local%wrap%comp_present(compocn)) ocnDone = .true. + if (.not. is_local%wrap%comp_present(compatm)) atmDone = .true. + + if (.not. atmDone .and. ocnDone .and. is_local%wrap%comp_present(compatm)) then + atmDone = .true. ! reset if an item is found that is not done + + call ESMF_StateGet(is_local%wrap%NStateImp(compatm), itemCount=fieldCount, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(fieldNameList(fieldCount)) + call ESMF_StateGet(is_local%wrap%NStateImp(compatm), itemNameList=fieldNameList, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + do n=1, fieldCount + call ESMF_StateGet(is_local%wrap%NStateImp(compatm), itemName=fieldNameList(n), field=field, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + atCorrectTime = NUOPC_IsAtTime(field, time, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (.not. atCorrectTime) then + ! If any atm import fields are not time stamped correctly, then dependency is not satisified - must return to atm + call ESMF_LogWrite("MED - Initialize-Data-Dependency from ATM NOT YET SATISFIED!!!", ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + atmdone = .false. + exit ! break out of the loop when first not satisfied found + endif + enddo + deallocate(fieldNameList) + + if (.not. atmdone) then ! atmdone is not true + ! Update fractions again in case any import fields have changed + call med_fraction_init(gcomp,rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call med_fraction_set(gcomp, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Initialize ocean albedo module and compute ocean albedos + call med_phases_ocnalb_run(gcomp, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! do the merge to the atmospheric component + call med_phases_prep_atm(gcomp, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! copy the FBExp(compatm) to NstatExp(compatm) + call med_connectors_prep_med2atm(gcomp, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! change 'Updated' attribute to true for ALL exportState fields + call ESMF_StateGet(is_local%wrap%NStateExp(compatm), itemCount=fieldCount, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(fieldNameList(fieldCount)) + call ESMF_StateGet(is_local%wrap%NStateExp(compatm), itemNameList=fieldNameList, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + do n=1, fieldCount + call ESMF_StateGet(is_local%wrap%NStateExp(compatm), itemName=fieldNameList(n), field=field, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_SetAttribute(field, name="Updated", value="true", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end do + deallocate(fieldNameList) + + ! Connectors will be automatically called between the mediator and atm until allDone is true + call ESMF_LogWrite("MED - Initialize-Data-Dependency Sending Data to ATM", ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + else + if (is_local%wrap%comp_present(compatm)) then + ! Copy the NstateImp(compatm) to FBImp(compatm) + call med_connectors_post_atm2med(gcomp, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + endif + + allDone = .true. + do n1 = 1,ncomps + if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then + + call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemCount=fieldCount, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(fieldNameList(fieldCount)) + call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemNameList=fieldNameList, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + do n=1, fieldCount + call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemName=fieldNameList(n), field=field, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + atCorrectTime = NUOPC_IsAtTime(field, time, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (.not. atCorrectTime) then + allDone=.false. + endif + enddo + deallocate(fieldNameList) + endif + + enddo + + ! set InitializeDataComplete Component Attribute to "true", indicating + ! to the driver that this Component has fully initialized its data + + if (allDone) then + call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite("MED - Initialize-Data-Dependency allDone check Passed", ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call med_io_init() + + !--------------------------------------- + ! read mediator restarts + !--------------------------------------- + + call NUOPC_CompAttributeGet(gcomp, name="read_restart", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(subname//' read_restart = '//trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) read_restart + + if (read_restart) then + call med_phases_restart_read(gcomp, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + call med_phases_profile(gcomp, rc) + else + call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite("MED - Initialize-Data-Dependency allDone check Failed, another loop is required", ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine DataInitialize + + !----------------------------------------------------------------------------- + + subroutine SetRunClock(gcomp, rc) + + use ESMF , only : ESMF_GridComp, ESMF_CLOCK, ESMF_Time, ESMF_TimeInterval + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_ClockGet, ESMF_ClockSet + use ESMF , only : ESMF_Success, ESMF_Failure + use ESMF , only : ESMF_Alarm, ESMF_ALARMLIST_ALL, ESMF_ClockGetAlarmList + use ESMF , only : ESMF_AlarmCreate, ESMF_AlarmSet, ESMF_ClockAdvance + use NUOPC , only : NUOPC_CompCheckSetClock, NUOPC_CompAttributeGet + use NUOPC_Mediator , only : NUOPC_MediatorGet + use shr_nuopc_time_mod , only : shr_nuopc_time_alarmInit + use shr_nuopc_methods_mod , only : shr_nuopc_methods_clock_timeprint + use shr_nuopc_time_mod , only : shr_nuopc_time_set_component_stop_alarm + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: mediatorClock, driverClock + type(ESMF_Time) :: currTime + type(ESMF_TimeInterval) :: timeStep + character(len=256) :: cvalue + character(len=256) :: restart_option ! Restart option units + integer :: restart_n ! Number until restart interval + integer :: restart_ymd ! Restart date (YYYYMMDD) + type(ESMF_ALARM) :: restart_alarm + type(ESMF_ALARM) :: med_profile_alarm + type(ESMF_ALARM) :: glc_avg_alarm + logical :: glc_present + character(len=16) :: glc_avg_period + integer :: dbrc + integer :: first_time = .true. + character(len=*),parameter :: subname='(module_MED:SetRunClock)' + !----------------------------------------------------------- + + rc = ESMF_SUCCESS + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + ! query the Mediator for clocks + call NUOPC_MediatorGet(gcomp, mediatorClock=mediatorClock, & + driverClock=driverClock, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 1) then + call shr_nuopc_methods_Clock_TimePrint(driverClock ,trim(subname)//'driver clock1',rc) + call shr_nuopc_methods_Clock_TimePrint(mediatorClock,trim(subname)//'mediat clock1',rc) + endif + + ! set the mediatorClock to have the current start time as the driverClock + call ESMF_ClockGet(driverClock, currTime=currTime, timeStep=timeStep, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockSet(mediatorClock, currTime=currTime, timeStep=timeStep, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 1) then + call shr_nuopc_methods_Clock_TimePrint(driverClock ,trim(subname)//'driver clock2',rc) + call shr_nuopc_methods_Clock_TimePrint(mediatorClock,trim(subname)//'mediat clock2',rc) + endif + + ! check and set the component clock against the driver clock + call NUOPC_CompCheckSetClock(gcomp, driverClock, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !-------------------------------- + ! set restart alarm, med log summary alarm and glc averaging alarm if appropriate + !-------------------------------- + + if (first_time) then + + ! Set mediator restart alarm + + call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) restart_n + + call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) restart_ymd + + call shr_nuopc_time_alarmInit(mediatorclock, restart_alarm, restart_option, & + opt_n = restart_n, & + opt_ymd = restart_ymd, & + RefTime = currTime, & + alarmname = 'alarm_restart', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_AlarmSet(restart_alarm, clock=mediatorclock, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Set mediator profile alarm - HARD CODED to daily + + call shr_nuopc_time_alarmInit(mediatorclock, med_profile_alarm, 'ndays', & + opt_n = 1, alarmname = 'med_profile_alarm', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_AlarmSet(med_profile_alarm, clock=mediatorclock, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Set glc averaging alarm if appropriate + + call NUOPC_CompAttributeGet(gcomp, name="glc_present", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + glc_present = (cvalue == "true") + if (glc_present) then + call NUOPC_CompAttributeGet(gcomp, name="glc_avg_period", value=glc_avg_period, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (trim(glc_avg_period) == 'hour') then + call shr_nuopc_time_alarmInit(mediatorclock, glc_avg_alarm, 'nhours', & + opt_n = 1, alarmname = 'alarm_glc_avg', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + else if (trim(glc_avg_period) == 'day') then + call shr_nuopc_time_alarmInit(mediatorclock, glc_avg_alarm, 'ndays', & + opt_n = 1, alarmname = 'alarm_glc_avg', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + else if (trim(glc_avg_period) == 'yearly') then + call shr_nuopc_time_alarmInit(mediatorclock, glc_avg_alarm, 'nyears', & + opt_n = 1, alarmname = 'alarm_glc_avg', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + else + call ESMF_LogWrite(trim(subname)//& + ": ERROR glc_avg_period = "//trim(glc_avg_period)//" not supported", & + ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + RETURN + end if + call ESMF_AlarmSet(glc_avg_alarm, clock=mediatorclock, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + call shr_nuopc_time_set_component_stop_alarm(gcomp, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + first_time = .false. + end if + + !-------------------------------- + ! Advance med clock to trigger alarms then reset model clock back to currtime + !-------------------------------- + + call ESMF_ClockAdvance(mediatorClock,rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockSet(mediatorClock, currTime=currtime, timeStep=timestep, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 5) then + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine SetRunClock + !----------------------------------------------------------------------------- + + subroutine med_finalize(gcomp, rc) + use ESMF , only : ESMF_GridComp, ESMF_SUCCESS + use med_internalstate_mod , only : logunit, mastertask + use med_phases_profile_mod , only : med_phases_profile_finalize + use shr_nuopc_utils_mod , only : shr_nuopc_memcheck + use shr_file_mod , only : shr_file_setlogunit + + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + call shr_file_setlogunit(logunit) + rc = ESMF_SUCCESS + call shr_nuopc_memcheck("med_finalize", 0, mastertask) + if (mastertask) then + write(logunit,*)' SUCCESSFUL TERMINATION OF CMEPS' + call med_phases_profile_finalize() + end if + + end subroutine med_finalize + + !----------------------------------------------------------------------------- + +end module MED diff --git a/src/mediator/med_connectors_mod.F90 b/src/mediator/med_connectors_mod.F90 new file mode 100644 index 00000000..ca3bff37 --- /dev/null +++ b/src/mediator/med_connectors_mod.F90 @@ -0,0 +1,553 @@ +module med_connectors_mod + + !----------------------------------------------------------------------------- + ! Connector phases + !----------------------------------------------------------------------------- + + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_Failure + use ESMF , only : ESMF_State, ESMF_Clock, ESMF_GridComp + use med_internalstate_mod , only : InternalState + use shr_nuopc_utils_mod , only : shr_nuopc_utils_ChkErr + use med_constants_mod , only : spval => med_constants_spval + use med_constants_mod , only : czero => med_constants_czero + + implicit none + private + character(*) , parameter :: u_FILE_u = & + __FILE__ + + !-------------------------------------------------------------------------- + ! Public interfaces + !-------------------------------------------------------------------------- + + public med_connectors_prep_med2atm + public med_connectors_prep_med2ocn + public med_connectors_prep_med2ice + public med_connectors_prep_med2lnd + public med_connectors_prep_med2rof + public med_connectors_prep_med2wav + public med_connectors_prep_med2glc + public med_connectors_post_atm2med + public med_connectors_post_ocn2med + public med_connectors_post_ice2med + public med_connectors_post_lnd2med + public med_connectors_post_rof2med + public med_connectors_post_wav2med + public med_connectors_post_glc2med + + !-------------------------------------------------------------------------- + ! Private + !-------------------------------------------------------------------------- + + private med_connectors_prep_generic + private med_connectors_post_generic + private med_connectors_diagnose + +!----------------------------------------------------------------------------- +contains +!----------------------------------------------------------------------------- + + subroutine med_connectors_prep_generic(gcomp, type, compid, rc) + use ESMF , only : ESMF_GridCompGet, ESMF_VMGet + use med_infodata_mod , only : med_infodata_CopyStateToInfodata + use med_infodata_mod , only : med_infodata_CopyInfodataToState + use med_infodata_mod , only : med_infodata + use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_reset + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_copy + use perf_mod , only : t_startf, t_stopf + ! input/output variables + type(ESMF_GridComp) :: gcomp + character(len=*), intent(in) :: type + integer, intent(in) :: compid + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(InternalState) :: is_local + logical :: diagnose + logical :: connected + integer :: n + integer :: dbrc + integer :: mytask + character(len=10) :: med2comp + character(len=7) :: cpl2comp + character(len=*),parameter :: subname='(med_connectors_prep_generic)' + !--------------------------------------------- + call t_startf('MED:'//subname) + call ESMF_LogWrite(trim(subname)//trim(type)//": called", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_SUCCESS + + ! query the Component for its clock, importState and exportState + call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + ! Get the internal state from Component. + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(is_local%wrap%vm, localPet=mytask, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + !------------------------- + ! diagnose export state + ! update scalar data in Exp and Imp State + !------------------------- + med2comp = "med_to_"//type + cpl2comp = "cpl2"//type + + is_local%wrap%conn_prep_cnt(compid) = is_local%wrap%conn_prep_cnt(compid) + 1 + call shr_nuopc_methods_State_reset(is_local%wrap%NStateExp(compid), value=spval, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_copy(is_local%wrap%NStateExp(compid), is_local%wrap%FBExp(compid), rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call med_connectors_diagnose(is_local%wrap%NStateExp(compid), is_local%wrap%conn_prep_cnt(compid), med2comp, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call med_infodata_CopyInfodataToState(med_infodata,is_local%wrap%NStateExp(compid), cpl2comp, mytask, rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call med_infodata_CopyInfodataToState(med_infodata,is_local%wrap%NStateImp(compid), cpl2comp, mytask, rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//trim(type)//": done", ESMF_LOGMSG_INFO, rc=rc) + + call t_stopf('MED:'//subname) + + end subroutine med_connectors_prep_generic + + !----------------------------------------------------------------------------- + + subroutine med_connectors_post_generic(gcomp, type, compid, rc) + + use ESMF , only : ESMF_GridCompGet + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_copy + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_reset + use med_infodata_mod , only : med_infodata + use med_infodata_mod , only : med_infodata_CopyStateToInfodata + use perf_mod , only : t_startf, t_stopf + ! input/output variables + type(ESMF_GridComp) :: gcomp + character(len=*), intent(in) :: type + integer, intent(in) :: compid + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(InternalState) :: is_local + integer :: dbrc + character(len=10) :: comp2med + character(len=7) :: comp2cpl + character(len=*),parameter :: subname='(med_connectors_post_generic)' + !--------------------------------------------- + + ! Note: for information obtained by the mediator always write out the state + ! if statewrite_flag is .true. + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + + call ESMF_LogWrite(trim(subname)//trim(type)//": called", ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + ! query the Component for its clock, importState and exportState + call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + ! Get the internal state from Component. + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + !------------------------- + ! diagnose import state + ! copy import state scalar data to local datatype + !------------------------- + comp2med = "med_from_"//type + comp2cpl = type//"2cpl" + + is_local%wrap%conn_post_cnt(compid) = is_local%wrap%conn_post_cnt(compid) + 1 + call med_connectors_diagnose(is_local%wrap%NStateImp(compid), is_local%wrap%conn_post_cnt(compid),comp2med, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call med_infodata_CopyStateToInfodata(is_local%wrap%NStateImp(compid),med_infodata, comp2cpl ,is_local%wrap%vm,rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_reset(is_local%wrap%FBImp(compid,compid), value=czero, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_copy(is_local%wrap%FBImp(compid,compid), is_local%wrap%NStateImp(compid), rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//trim(type)//": done", ESMF_LOGMSG_INFO, rc=rc) + + call t_stopf('MED:'//subname) + + end subroutine med_connectors_post_generic + + !----------------------------------------------------------------------------- + + subroutine med_connectors_prep_med2atm(gcomp, rc) + use perf_mod, only : t_startf, t_stopf + use esmFlds, only : compatm + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + integer :: dbrc + character(len=*),parameter :: subname='(med_connectors_prep_med2atm)' + !--------------------------------------------- + call t_startf('MED:'//subname) + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + + rc = ESMF_SUCCESS + + call med_connectors_prep_generic(gcomp, 'atm', compatm, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + call t_stopf('MED:'//subname) + + end subroutine med_connectors_prep_med2atm + + !----------------------------------------------------------------------------- + + subroutine med_connectors_prep_med2ocn(gcomp, rc) + use esmFlds, only : compocn + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + integer :: dbrc + character(len=*),parameter :: subname='(med_connectors_prep_med2ocn)' + !--------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + + rc = ESMF_SUCCESS + + call med_connectors_prep_generic(gcomp, 'ocn', compocn, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + + end subroutine med_connectors_prep_med2ocn + + !----------------------------------------------------------------------------- + + subroutine med_connectors_prep_med2ice(gcomp, rc) + use esmFlds, only : compice + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + integer :: dbrc + character(len=*),parameter :: subname='(med_connectors_prep_med2ice)' + !--------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_SUCCESS + + call med_connectors_prep_generic(gcomp, 'ice', compice, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + + end subroutine med_connectors_prep_med2ice + + !----------------------------------------------------------------------------- + + subroutine med_connectors_prep_med2lnd(gcomp, rc) + use esmFlds, only : complnd + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + integer :: dbrc + character(len=*),parameter :: subname='(med_connectors_prep_med2lnd)' + !--------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_SUCCESS + + call med_connectors_prep_generic(gcomp, 'lnd', complnd, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + + end subroutine med_connectors_prep_med2lnd + + !----------------------------------------------------------------------------- + + subroutine med_connectors_prep_med2rof(gcomp, rc) + use esmFlds, only : comprof + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + integer :: dbrc + character(len=*),parameter :: subname='(med_connectors_prep_med2rof)' + !--------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_SUCCESS + + call med_connectors_prep_generic(gcomp, 'rof', comprof, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + + end subroutine med_connectors_prep_med2rof + + !----------------------------------------------------------------------------- + + subroutine med_connectors_prep_med2wav(gcomp, rc) + use esmFlds, only : compwav + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + integer :: dbrc + character(len=*),parameter :: subname='(med_connectors_prep_med2wav)' + !--------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + + rc = ESMF_SUCCESS + + call med_connectors_prep_generic(gcomp, 'wav', compwav, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + + end subroutine med_connectors_prep_med2wav + + !----------------------------------------------------------------------------- + + subroutine med_connectors_prep_med2glc(gcomp, rc) + use esmFlds, only : compglc + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + integer :: dbrc + character(len=*),parameter :: subname='(med_connectors_prep_med2glc)' + !--------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_SUCCESS + + call med_connectors_prep_generic(gcomp, 'glc', compglc, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + + end subroutine med_connectors_prep_med2glc + + !----------------------------------------------------------------------------- + + subroutine med_connectors_post_atm2med(gcomp, rc) + use esmFlds, only : compatm + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + integer :: dbrc + character(len=*),parameter :: subname='(med_connectors_post_atm2med)' + !--------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + + rc = ESMF_SUCCESS + + call med_connectors_post_generic(gcomp, 'atm', compatm, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + + end subroutine med_connectors_post_atm2med + + !----------------------------------------------------------------------------- + + subroutine med_connectors_post_ocn2med(gcomp, rc) + use esmFlds, only : compocn + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + integer :: dbrc + character(len=*),parameter :: subname='(med_connectors_post_ocn2med)' + !--------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_SUCCESS + + call med_connectors_post_generic(gcomp, 'ocn', compocn, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + + end subroutine med_connectors_post_ocn2med + + !----------------------------------------------------------------------------- + + subroutine med_connectors_post_ice2med(gcomp, rc) + use esmFlds, only : compice + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + integer :: dbrc + character(len=*),parameter :: subname='(med_connectors_post_ice2med)' + !--------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_SUCCESS + + call med_connectors_post_generic(gcomp, 'ice', compice, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + + end subroutine med_connectors_post_ice2med + + !----------------------------------------------------------------------------- + + subroutine med_connectors_post_lnd2med(gcomp, rc) + use esmFlds, only : complnd + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + integer :: dbrc + character(len=*),parameter :: subname='(med_connectors_post_lnd2med)' + !--------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_SUCCESS + + call med_connectors_post_generic(gcomp, 'lnd', complnd, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + + end subroutine med_connectors_post_lnd2med + + !----------------------------------------------------------------------------- + + subroutine med_connectors_post_rof2med(gcomp, rc) + use esmFlds, only : comprof + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + integer :: dbrc + character(len=*),parameter :: subname='(med_connectors_post_rof2med)' + !--------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_SUCCESS + + call med_connectors_post_generic(gcomp, 'rof', comprof, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + + end subroutine med_connectors_post_rof2med + + !----------------------------------------------------------------------------- + + subroutine med_connectors_post_wav2med(gcomp, rc) + use esmFlds, only : compwav + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + integer :: dbrc + character(len=*),parameter :: subname='(med_connectors_post_wav2med)' + !--------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + + rc = ESMF_SUCCESS + + call med_connectors_post_generic(gcomp, 'wav', compwav, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + + end subroutine med_connectors_post_wav2med + + !----------------------------------------------------------------------------- + + subroutine med_connectors_post_glc2med(gcomp, rc) + use esmFlds, only : compglc + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + integer :: dbrc + character(len=*),parameter :: subname='(med_connectors_post_glc2med)' + !--------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_SUCCESS + + call med_connectors_post_generic(gcomp, 'glc', compglc, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + + end subroutine med_connectors_post_glc2med + + !----------------------------------------------------------------------------- + + subroutine med_connectors_diagnose(State, cntr, string, rc) + + use ESMF , only : ESMF_State, ESMF_MAXSTR, ESMF_StateGet + use NUOPC , only : NUOPC_Write + use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_diagnose + use med_constants_mod , only : statewrite_flag => med_constants_statewrite_flag + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + + ! input/output variables + type(ESMF_State), intent(in) :: State + integer , intent(inout) :: cntr + character(len=*), intent(in) :: string + integer , intent(out) :: rc + + ! local variables + integer :: fieldCount + character(ESMF_MAXSTR),pointer :: fieldnamelist(:) + integer :: dbrc + character(len=*),parameter :: subname='(med_connectors_diagnose)' + !--------------------------------------------- + + call ESMF_LogWrite(trim(subname)//trim(string)//": called", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_SUCCESS + + call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + ! Obtain the field names in State - allocate memory which will be deallocated at the end + allocate(fieldnamelist(fieldCount)) + call ESMF_StateGet(State, itemNameList=fieldnamelist, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 1) then + call shr_nuopc_methods_State_diagnose(State, string=trim(subname)//trim(string), rc=rc) + endif + + ! Write out the fields in State to netcdf files + if (cntr > 0 .and. statewrite_flag) then + call ESMF_LogWrite(trim(subname)//trim(string)//": writing out fields", ESMF_LOGMSG_INFO, rc=rc) + call NUOPC_Write(State, & + fieldnamelist(1:fieldCount), & + "field_"//trim(string)//"_", timeslice=cntr, & + overwrite=.true., relaxedFlag=.true., rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + endif + + deallocate(fieldnamelist) + + call ESMF_LogWrite(trim(subname)//trim(string)//": done", ESMF_LOGMSG_INFO, rc=rc) + + end subroutine med_connectors_diagnose + + !----------------------------------------------------------------------------- + +end module med_connectors_mod diff --git a/src/mediator/med_fraction_mod.F90 b/src/mediator/med_fraction_mod.F90 new file mode 100644 index 00000000..1363f466 --- /dev/null +++ b/src/mediator/med_fraction_mod.F90 @@ -0,0 +1,840 @@ +module med_fraction_mod + + !----------------------------------------------------------------------------- + ! Mediator Component. + ! Sets fracations on all component grids + ! the fractions fields are now afrac, ifrac, ofrac, lfrac, and lfrin. + ! afrac = fraction of atm on a grid + ! lfrac = fraction of lnd on a grid + ! ifrac = fraction of ice on a grid + ! ofrac = fraction of ocn on a grid + ! lfrin = land fraction defined by the land model + ! ifrad = fraction of ocn on a grid at last radiation time + ! ofrad = fraction of ice on a grid at last radiation time + ! + ! afrac, lfrac, ifrac, and ofrac: + ! are the self-consistent values in the system + ! lfrin: + ! is the fraction on the land grid and is allowed to + ! vary from the self-consistent value as descibed below. + ! ifrad and ofrad: + ! are needed for the swnet calculation. + ! + ! the fractions fields are defined for each grid in the fraction bundles as + ! needed as follows. + ! character(*),parameter :: fraclist_a = 'afrac:ifrac:ofrac:lfrac:lfrin' + ! character(*),parameter :: fraclist_o = 'afrac:ifrac:ofrac:ifrad:ofrad' + ! character(*),parameter :: fraclist_i = 'afrac:ifrac:ofrac' + ! character(*),parameter :: fraclist_l = 'afrac:lfrac:lfrin' + ! character(*),parameter :: fraclist_g = 'gfrac:lfrac' + ! character(*),parameter :: fraclist_r = 'lfrac:rfrac' + ! + ! we assume ocean and ice are on the same grids, same masks + ! we assume ocn2atm and ice2atm are masked maps + ! we assume lnd2atm is a global map + ! we assume that the ice fraction evolves in time but that + ! the land model fraction does not. the ocean fraction then + ! is just the complement of the ice fraction over the region + ! of the ocean/ice mask. + ! we assume that component fractions sent at runtime + ! are always the relative fraction covered. + ! for example, if an ice cell can be up to 50% covered in + ! ice and 50% land, then the ice domain should have a fraction + ! value of 0.5 at that grid cell. at run time though, the ice + ! fraction will be between 0.0 and 1.0 meaning that grid cells + ! is covered with between 0.0 and 0.5 by ice. the "relative" fractions + ! sent at run-time are corrected by the model to be total fractions + ! such that in general, on every grid, + ! fractions_*(afrac) = 1.0 + ! fractions_*(ifrac) + fractions_*(ofrac) + fractions_*(lfrac) = 1.0 + ! where fractions_* are a bundle of fractions on a particular grid and + ! *frac (ie afrac) is the fraction of a particular component in the bundle. + ! + ! the fractions are computed fundamentally as follows (although the + ! detailed implementation might be slightly different) + ! + ! initialization: + ! afrac is set on all grids + ! fractions_a(afrac) = 1.0 + ! fractions_o(afrac) = mapa2o(fractions_a(afrac)) + ! fractions_i(afrac) = mapa2i(fractions_a(afrac)) + ! fractions_l(afrac) = mapa2l(fractions_a(afrac)) + ! initially assume ifrac on all grids is zero + ! fractions_*(ifrac) = 0.0 + ! fractions/masks provided by surface components + ! fractions_o(ofrac) = ocean "mask" provided by ocean + ! fractions_l(lfrin) = land "fraction provided by land + ! then mapped to the atm model + ! fractions_a(ofrac) = mapo2a(fractions_o(ofrac)) + ! fractions_a(lfrin) = mapl2a(fractions_l(lfrin)) + ! and a few things are then derived + ! fractions_a(lfrac) = 1.0 - fractions_a(ofrac) + ! this is truncated to zero for very small values (< 0.001) + ! to attempt to preserve non-land gridcells. + ! fractions_l(lfrac) = mapa2l(fractions_a(lfrac)) + ! fractions_r(lfrac) = mapl2r(fractions_l(lfrac)) + ! fractions_g(lfrac) = mapl2g(fractions_l(lfrac)) + ! + ! run-time (frac_set): + ! update fractions on ice grid + ! fractions_i(ifrac) = i2x_i(Si_ifrac) ! ice frac from ice model + ! fractions_i(ofrac) = 1.0 - fractions_i(ifrac) + ! note: the relative fractions are corrected to total fractions + ! fractions_o(ifrac) = mapi2o(fractions_i(ifrac)) + ! fractions_o(ofrac) = mapi2o(fractions_i(ofrac)) + ! fractions_a(ifrac) = mapi2a(fractions_i(ifrac)) + ! fractions_a(ofrac) = mapi2a(fractions_i(ofrac)) + ! + ! fractions used in merging are as follows + ! merge to atm uses fractions_a(lfrac,ofrac,ifrac) + ! merge to ocean uses fractions_o(ofrac,ifrac) normalized to one + ! + ! fraction corrections in mapping are as follows + ! mapo2a uses *fractions_o(ofrac) and /fractions_a(ofrac) + ! mapi2a uses *fractions_i(ifrac) and /fractions_a(ifrac) + ! mapl2a uses *fractions_l(lfrin) and /fractions_a(lfrin) + ! mapl2g weights by fractions_l(lfrac) with normalization and multiplies by fractions_g(lfrac) + ! mapa2* should use *fractions_a(afrac) and /fractions_*(afrac) but this + ! has been defered since the ratio always close to 1.0 + ! + ! run time: + ! fractions_a(lfrac) + fractions_a(ofrac) + fractions_a(ifrac) ~ 1.0 + ! 0.0-eps < fractions_*(*) < 1.0+eps + ! + ! Note that the following FBImp field names are current hard-wired below + ! TODO: this needs to be generalized - these names should be set dynamically at run time in the + ! source component + ! is_local%wrap%FBImp(compglc,compglc) => 'frac' + ! is_local%wrap%FBImp(complnd,complnd) => 'Sl_lfrin' + ! is_local%wrap%FBImp(compice,compice) => 'Si_imask' + ! is_local%wrap%FBImp(compocn,compocn) => 'So_omask' + ! is_local%wrap%FBImp(compice,compice) => 'Si_ifrac' (runtime) + ! + !----------------------------------------------------------------------------- + + use med_constants_mod, only : R8 + use med_constants_mod, only : dbug_flag => med_constants_dbug_flag + use esmFlds , only : ncomps + + implicit none + private + + ! Note - everything is private in this module other than these routines + public med_fraction_init + public med_fraction_set + + integer, parameter :: nfracs = 5 + character(len=5) :: fraclist(nfracs,ncomps) + character(len=5),parameter,dimension(5) :: fraclist_a = (/'afrac','ifrac','ofrac','lfrac','lfrin'/) + character(len=5),parameter,dimension(5) :: fraclist_o = (/'afrac','ifrac','ofrac','ifrad','ofrad'/) + character(len=5),parameter,dimension(3) :: fraclist_i = (/'afrac','ifrac','ofrac'/) + character(len=5),parameter,dimension(3) :: fraclist_l = (/'afrac','lfrac','lfrin'/) + character(len=5),parameter,dimension(2) :: fraclist_g = (/'gfrac','lfrac'/) + character(len=5),parameter,dimension(2) :: fraclist_r = (/'rfrac','lfrac'/) + character(len=5),parameter,dimension(1) :: fraclist_w = (/'wfrac'/) + + !--- standard --- + real(R8),parameter :: eps_fracsum = 1.0e-02 ! allowed error in sum of fracs + real(R8),parameter :: eps_fracval = 1.0e-02 ! allowed error in any frac +- 0,1 + real(R8),parameter :: eps_fraclim = 1.0e-03 ! truncation limit in fractions_a(lfrac) + logical ,parameter :: atm_frac_correct = .false. ! turn on frac correction on atm grid + + !--- standard plus atm fraction consistency --- + ! real(R8),parameter :: eps_fracsum = 1.0e-12 ! allowed error in sum of fracs + ! real(R8),parameter :: eps_fracval = 1.0e-02 ! allowed error in any frac +- 0,1 + ! real(R8),parameter :: eps_fraclim = 1.0e-03 ! truncation limit in fractions_a(lfrac) + ! logical ,parameter :: atm_frac_correct = .true. ! turn on frac correction on atm grid + + !--- unconstrained and area conserving? --- + ! real(R8),parameter :: eps_fracsum = 1.0e-12 ! allowed error in sum of fracs + ! real(R8),parameter :: eps_fracval = 1.0e-02 ! allowed error in any frac +- 0,1 + ! real(R8),parameter :: eps_fraclim = 1.0e-20 ! truncation limit in fractions_a(lfrac) + ! logical ,parameter :: atm_frac_correct = .true. ! turn on frac correction on atm grid + + character(*), parameter :: u_FILE_u = & + __FILE__ + +!----------------------------------------------------------------------------- +contains +!----------------------------------------------------------------------------- + + subroutine med_fraction_init(gcomp, rc) + + ! Initialize FBFrac(:) field bundles + + use ESMF , only : ESMF_GridComp, ESMF_Field + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_GridCompGet, ESMF_StateIsCreated, ESMF_RouteHandleIsCreated + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleIsCreated, ESMF_FieldBundleDestroy + use med_constants_mod , only : czero=>med_constants_czero + use esmFlds , only : compatm, compocn, compice, complnd + use esmFlds , only : comprof, compglc, compwav, compname + use esmFlds , only : mapconsf, mapfcopy + use shr_nuopc_scalars_mod , only : flds_scalar_name + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_init + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_reset + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFldPtr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FieldRegrid + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_fldChk + use med_map_mod , only : med_map_Fractions_init + use med_internalstate_mod , only : InternalState + use perf_mod , only : t_startf, t_stopf + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + type(ESMF_FieldBundle) :: FBtemp + real(R8), pointer :: frac(:) + real(R8), pointer :: ofrac(:) + real(R8), pointer :: lfrac(:) + real(R8), pointer :: ifrac(:) + real(R8), pointer :: afrac(:) + real(R8), pointer :: gfrac(:) + real(R8), pointer :: lfrin(:) + real(R8), pointer :: rfrac(:) + real(R8), pointer :: wfrac(:) + real(R8), pointer :: Sl_lfrin(:) + real(R8), pointer :: Si_imask(:) + real(R8), pointer :: So_omask(:) + integer :: i,j,n,n1 + integer :: maptype + integer :: dbrc + logical, save :: first_call = .true. + character(len=*),parameter :: subname='(med_fraction_init)' + !--------------------------------------- + call t_startf('MED:'//subname) + + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + end if + rc = ESMF_SUCCESS + + ! Get the internal state from Component. + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (first_call) then + + !--------------------------------------- + ! Initialize the fraclist arrays + !--------------------------------------- + + fraclist(:,:) = ' ' + fraclist(1:size(fraclist_a),compatm) = fraclist_a + fraclist(1:size(fraclist_o),compocn) = fraclist_o + fraclist(1:size(fraclist_i),compice) = fraclist_i + fraclist(1:size(fraclist_l),complnd) = fraclist_l + fraclist(1:size(fraclist_r),comprof) = fraclist_r + fraclist(1:size(fraclist_w),compwav) = fraclist_w + fraclist(1:size(fraclist_g),compglc) = fraclist_g + + !--------------------------------------- + ! Initialize FBFrac(:) to zero + !--------------------------------------- + + ! Note - must use import state here - since export state might not + ! contain anything other than scalar data if the component is not prognostic + do n1 = 1,ncomps + if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then + + call shr_nuopc_methods_FB_init(is_local%wrap%FBfrac(n1), flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(n1), fieldNameList=fraclist(:,n1), & + name='FBfrac'//trim(compname(n1)), rc=rc) + + ! zero out FBfracs + call shr_nuopc_methods_FB_reset(is_local%wrap%FBfrac(n1), value=czero, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end do + first_call = .false. + endif + + !--------------------------------------- + ! Set 'afrac' for FBFrac(compatm), FBFrac(compice), FBFrac(compocn), FBFrac(complnd) + !--------------------------------------- + + if (is_local%wrap%comp_present(compatm)) then + + ! Set 'afrac' for FBFrac(compatm) to 1 + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'afrac', afrac, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + afrac(:) = 1.0_R8 + + ! Set 'afrac' for FBFrac(compice), FBFrac(compocn) and FBFrac(complnd) + do n = 1,ncomps + if (n == compice .or. n == compocn .or. n == complnd) then + if (is_local%wrap%med_coupling_active(compatm,n)) then + if (ESMF_RouteHandleIsCreated(is_local%wrap%RH(compatm,n,mapfcopy), rc=rc)) then + maptype = mapfcopy + else + maptype = mapconsf + if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(compatm,n,mapconsf), rc=rc)) then + call med_map_Fractions_init( gcomp, compatm, n, & + FBSrc=is_local%wrap%FBImp(compatm,compatm), & + FBDst=is_local%wrap%FBImp(compatm,n), & + RouteHandle=is_local%wrap%RH(compatm,n,mapconsf), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + call shr_nuopc_methods_FB_FieldRegrid(& + is_local%wrap%FBfrac(compatm), 'afrac', & + is_local%wrap%FBfrac(n), 'afrac', & + is_local%wrap%RH(compatm,n,maptype), rc=rc) + if(shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + end if + end do + end if + + !--------------------------------------- + ! Set 'lfrin' for FBFrac(complnd) and FBFrac(compatm) + !--------------------------------------- + + ! The following is just an initial "guess", updated later + + if (is_local%wrap%comp_present(complnd)) then + + ! Set 'lfrin' for FBFrac(complnd) + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBImp(complnd,complnd) , 'Sl_lfrin' , Sl_lfrin, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(complnd), 'lfrin', lfrin, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + lfrin(:) = Sl_lfrin(:) + + ! Set 'lfrin for FBFrac(compatm) + if (is_local%wrap%comp_present(compatm) .and. (is_local%wrap%med_coupling_active(compatm,complnd))) then + ! Note - need to do the following if compatm->complnd is active, even if complnd->compatm is not active + + ! Create a temporary field bundle if one does not exists + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(complnd,compatm))) then + call shr_nuopc_methods_FB_init(FBout=FBtemp, & + flds_scalar_name=flds_scalar_name, & + FBgeom=is_local%wrap%FBImp(compatm,compatm), & + fieldNameList=(/'Fldtemp'/), name='FBtemp', rc=rc) + if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + end if + + ! Determine map type + if (ESMF_RouteHandleIsCreated(is_local%wrap%RH(compatm,complnd,mapfcopy), rc=rc)) then + maptype = mapfcopy + else + maptype = mapconsf + end if + + ! Create route handle from lnd->atm if necessary + if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(complnd,compatm,maptype), rc=rc)) then + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(complnd,compatm))) then + call med_map_Fractions_init( gcomp, complnd, compatm, & + FBSrc=is_local%wrap%FBImp(complnd,complnd), & + FBDst=is_local%wrap%FBImp(complnd,compatm), & + RouteHandle=is_local%wrap%RH(complnd,compatm,maptype), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else + call med_map_Fractions_init( gcomp, complnd, compatm, & + FBSrc=is_local%wrap%FBImp(complnd,complnd), & + FBDst=FBtemp, & + RouteHandle=is_local%wrap%RH(complnd,compatm,maptype), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + + ! Regrid 'lfrin' from FBFrac(complnd) -> FBFrac(compatm) + call shr_nuopc_methods_FB_FieldRegrid(& + is_local%wrap%FBfrac(complnd), 'lfrin', & + is_local%wrap%FBfrac(compatm), 'lfrin', & + is_local%wrap%RH(complnd,compatm,maptype), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Destroy temporary field bundle if created + if (ESMF_FieldBundleIsCreated(FBTemp)) then + call ESMF_FieldBundleDestroy(FBtemp, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + end if + + !--------------------------------------- + ! Set 'ifrac' in FBFrac(compice) and BFrac(compatm) + !--------------------------------------- + + if (is_local%wrap%comp_present(compice)) then + + ! Set 'ifrac' FBFrac(compice) + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBImp(compice,compice) , 'Si_imask' , Si_imask, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compice), 'ifrac', ifrac, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ifrac(:) = Si_imask(:) + + ! Set 'ifrac' in FBFrac(compatm) + if (is_local%wrap%comp_present(compatm)) then + if (is_local%wrap%med_coupling_active(compice,compatm)) then + if (ESMF_RouteHandleIsCreated(is_local%wrap%RH(compice,compatm,mapfcopy), rc=rc)) then + maptype = mapfcopy + else + maptype = mapconsf + if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(compice,compatm,maptype), rc=rc)) then + call med_map_Fractions_init( gcomp, compice, compatm, & + FBSrc=is_local%wrap%FBImp(compice,compice), & + FBDst=is_local%wrap%FBImp(compice,compatm), & + RouteHandle=is_local%wrap%RH(compice,compatm,maptype), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + call shr_nuopc_methods_FB_FieldRegrid(& + is_local%wrap%FBfrac(compice), 'ifrac', & + is_local%wrap%FBfrac(compatm), 'ifrac', & + is_local%wrap%RH(compice,compatm,maptype), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + endif + endif + + !--------------------------------------- + ! Set 'ofrac' in FBFrac(compocn) and FBFrac(compatm) + !--------------------------------------- + + if (is_local%wrap%comp_present(compocn)) then + + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBImp(compocn,compocn) , 'So_omask', So_omask, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac', ofrac, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ofrac(:) = So_omask(:) + + if (is_local%wrap%med_coupling_active(compocn,compatm)) then + if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(compocn,compatm,mapconsf), rc=rc)) then + call med_map_Fractions_init( gcomp, compocn, compatm, & + FBSrc=is_local%wrap%FBImp(compocn,compocn), & + FBDst=is_local%wrap%FBImp(compocn,compatm), & + RouteHandle=is_local%wrap%RH(compocn,compatm,mapconsf), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call shr_nuopc_methods_FB_FieldRegrid(& + is_local%wrap%FBfrac(compocn), 'ofrac', & + is_local%wrap%FBfrac(compatm), 'ofrac', & + is_local%wrap%RH(compocn,compatm,mapconsf), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + + + !--------------------------------------- + ! Set 'lfrac' in FBFrac(compatm) and correct 'ofrac' in FBFrac(compatm) + ! --------------------------------------- + + ! These should actually be mapo2a of ofrac and lfrac but we can't + ! map lfrac from o2a due to masked mapping weights. So we have to + ! settle for a residual calculation that is truncated to zero to + ! try to preserve "all ocean" cells. + + if (is_local%wrap%comp_present(compatm)) then + + if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compice)) then + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc) + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc=rc) + + if (.not. is_local%wrap%comp_present(complnd)) then + lfrac(:) = 0.0_R8 + if (atm_frac_correct) then + ofrac(:) = 1.0_R8 + end if + else + do n = 1,size(lfrac) + lfrac(n) = 1.0_R8 - ofrac(n) + if (abs(lfrac(n)) < eps_fraclim) then + lfrac(n) = 0.0_R8 + if (atm_frac_correct) then + ofrac(n) = 1.0_R8 + end if + end if + end do + end if + + else if (is_local%wrap%comp_present(complnd)) then + + ! If the ocean or ice are absent, then simply set 'lfrac' to 'lfrin' for FBFrac(compatm) + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'lfrin', lfrin, rc=rc) + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc) + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc=rc) + do n = 1,size(lfrac) + lfrac(n) = lfrin(n) + ofrac(n) = 1.0_R8 - lfrac(n) + if (abs(ofrac(n)) < eps_fraclim) then + ofrac(n) = 0.0_R8 + if (atm_frac_correct) then + lfrac(n) = 1.0_R8 + endif + end if + end do + + end if + end if + + !--------------------------------------- + ! Set 'lfrac' in FBFrac(complnd) + !--------------------------------------- + + if (is_local%wrap%comp_present(complnd)) then + + ! Set 'lfrac' in FBFrac(complnd) + if (is_local%wrap%comp_present(compatm)) then + ! If atm -> lnd coupling is active - map 'lfrac' from FBFrac(compatm) to FBFrac(complnd) + if (is_local%wrap%med_coupling_active(compatm,complnd)) then + if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(compatm,complnd,mapconsf), rc=rc)) then + call med_map_Fractions_init( gcomp, compatm, complnd, & + FBSrc=is_local%wrap%FBImp(compatm,compatm), & + FBDst=is_local%wrap%FBImp(compatm,complnd), & + RouteHandle=is_local%wrap%RH(compatm,complnd,mapconsf), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call shr_nuopc_methods_FB_FieldRegrid(& + is_local%wrap%FBfrac(compatm), 'lfrac', & + is_local%wrap%FBfrac(complnd), 'lfrac', & + is_local%wrap%RH(compatm,complnd,mapconsf), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + else + ! If the atm ->lnd coupling is not active - simply set 'lfrac' to 'lfrin' + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(complnd), 'lfrin', lfrin, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(complnd), 'lfrac', lfrac, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + lfrac(:) = lfrin(:) + endif + + endif + + !--------------------------------------- + ! Set 'rfrac' and 'lfrac' for FBFrac(comprof) + !--------------------------------------- + + if (is_local%wrap%comp_present(comprof)) then + + ! Set 'rfrac' in FBFrac(comprof) + if ( shr_nuopc_methods_FB_FldChk(is_local%wrap%FBfrac(comprof) , 'rfrac', rc=rc) .and. & + shr_nuopc_methods_FB_FldChk(is_local%wrap%FBImp(comprof, comprof), 'frac' , rc=rc)) then + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(comprof) , 'rfrac', rfrac, rc=rc) + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBImp(comprof,comprof), 'frac' , frac, rc=rc) + rfrac(:) = frac(:) + else + ! Set 'rfrac' in FBfrac(comprof) to 1. + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(comprof), 'rfrac', rfrac, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + rfrac(:) = 1.0_R8 + endif + + ! Set 'lfrac' in FBFrac(comprof) + if (is_local%wrap%comp_present(complnd)) then + if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(complnd,comprof,mapconsf), rc=rc)) then + call med_map_Fractions_init( gcomp, complnd, comprof, & + FBSrc=is_local%wrap%FBImp(complnd,complnd), & + FBDst=is_local%wrap%FBImp(complnd,comprof), & + RouteHandle=is_local%wrap%RH(complnd,comprof,mapconsf), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call shr_nuopc_methods_FB_FieldRegrid(& + is_local%wrap%FBfrac(complnd), 'lfrac', & + is_local%wrap%FBfrac(comprof), 'lfrac', & + is_local%wrap%RH(complnd,comprof,mapconsf), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + endif + + !--------------------------------------- + ! Set 'gfrac' and 'lfrac' for FBFrac(compglc) + !--------------------------------------- + + if (is_local%wrap%comp_present(compglc)) then + ! Set 'gfrac' in FBFrac(compglc) + if ( shr_nuopc_methods_FB_FldChk(is_local%wrap%FBfrac(compglc) , 'gfrac', rc=rc) .and. & + shr_nuopc_methods_FB_FldChk(is_local%wrap%FBImp(compglc, compglc), 'frac' , rc=rc)) then + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compglc) , 'gfrac', gfrac, rc=rc) + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBImp(compglc,compglc), 'frac' , frac, rc=rc) + gfrac(:) = frac(:) + else + ! Set 'gfrac' in FBfrac(compglc) to 1. + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compglc), 'gfrac', gfrac, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + gfrac(:) = 1.0_R8 + endif + + ! Set 'lfrac' in FBFrac(compglc) + if (is_local%wrap%comp_present(complnd)) then + if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(complnd,compglc,mapconsf), rc=rc)) then + call med_map_Fractions_init( gcomp, complnd, compglc, & + FBSrc=is_local%wrap%FBImp(complnd,complnd), & + FBDst=is_local%wrap%FBImp(complnd,compglc), & + RouteHandle=is_local%wrap%RH(complnd,compglc,mapconsf), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call shr_nuopc_methods_FB_FieldRegrid(& + is_local%wrap%FBfrac(complnd), 'lfrac', & + is_local%wrap%FBfrac(compglc), 'lfrac', & + is_local%wrap%RH(complnd,compglc,mapconsf), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + endif + + !--------------------------------------- + ! Set 'wfrac' for FBFrac(compwav) + !--------------------------------------- + + if (is_local%wrap%comp_present(compwav)) then + ! Set 'wfrac' in FBfrac(compwav) to 1. + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compwav), 'wfrac', wfrac, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + wfrac(:) = 1.0_R8 + endif + + !--------------------------------------- + ! Diagnostic output + !--------------------------------------- + + do n = 1,ncomps + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBfrac(n), trim(subname) // trim(compname(n)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + enddo + + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + end if + + call t_stopf('MED:'//subname) + + end subroutine med_fraction_init + + !----------------------------------------------------------------------------- + + subroutine med_fraction_set(gcomp, rc) + + ! Update time varying fractions + + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use ESMF , only : ESMF_RouteHandleIsCreated, ESMF_FieldBundleIsCreated + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_REGION_TOTAL, ESMF_REGION_SELECT + use esmFlds , only : compatm, compocn, compice, compname + use esmFlds , only : mapconsf, mapnstod, mapfcopy + use esmFlds , only : coupling_mode + use med_internalstate_mod , only : InternalState + use med_map_mod , only : med_map_Fractions_init + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFldPtr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FieldRegrid + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use perf_mod , only : t_startf, t_stopf + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + real(r8), pointer :: lfrac(:) + real(r8), pointer :: ifrac(:) + real(r8), pointer :: ofrac(:) + real(r8), pointer :: Si_ifrac(:) + real(r8), pointer :: Si_imask(:) + integer :: n + integer :: dbrc + character(len=*),parameter :: subname='(med_fraction_set)' + !--------------------------------------- + call t_startf('MED:'//subname) + + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + end if + rc = ESMF_SUCCESS + + ! Get the internal state from Component. + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + ! Update FBFrac(compice), FBFrac(compocn) and FBFrac(compatm) field bundles + !--------------------------------------- + + if (is_local%wrap%med_coupling_active(compice,compocn)) then + if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(compice,compocn,mapfcopy), rc=rc)) then + call med_map_Fractions_init( gcomp, compice, compocn, & + FBSrc=is_local%wrap%FBImp(compice,compice), & + FBDst=is_local%wrap%FBImp(compice,compocn), & + RouteHandle=is_local%wrap%RH(compice,compocn,mapfcopy), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(compocn,compice,mapfcopy), rc=rc)) then + call med_map_Fractions_init( gcomp, compocn, compice, & + FBSrc=is_local%wrap%FBImp(compocn,compocn), & + FBDst=is_local%wrap%FBImp(compocn,compice), & + RouteHandle=is_local%wrap%RH(compocn,compice,mapfcopy), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + + if (is_local%wrap%comp_present(compice)) then + + ! ------------------------------------------- + ! Set FBfrac(compice) + ! ------------------------------------------- + + ! Si_imask is the ice domain mask which is constant over time + ! Si_ifrac is the time evolving ice fraction on the ice grid + + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBImp(compice,compice) , 'Si_ifrac', Si_ifrac, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBImp(compice,compice) , 'Si_imask' , Si_imask, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compice), 'ifrac', ifrac, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compice), 'ofrac', ofrac, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! set ifrac = Si_ifrac * Si_imask + ifrac(:) = Si_ifrac(:) * Si_imask(:) + + if (trim(coupling_mode) == 'nems_orig') then + ofrac(:) = 1._r8 - ifrac(:) + else + ! set ofrac = Si_imask - ifrac + ofrac(:) = Si_imask(:) - ifrac(:) + end if + + ! ------------------------------------------- + ! Set FBfrac(compocn) + ! ------------------------------------------- + + ! The following is just a redistribution from FBFrac(compice) + + ! Map 'ifrac' from FBfrac(compice) to FBfrac(compocn) + if (is_local%wrap%comp_present(compocn)) then + if (is_local%wrap%med_coupling_active(compice,compocn)) then + call shr_nuopc_methods_FB_FieldRegrid(& + is_local%wrap%FBfrac(compice), 'ifrac', & + is_local%wrap%FBfrac(compocn), 'ifrac', & + is_local%wrap%RH(compice,compocn,mapfcopy), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + + ! Map 'ofrac' from FBfrac(compice) to FBfrac(comp) + if (is_local%wrap%med_coupling_active(compice,compocn)) then + call shr_nuopc_methods_FB_FieldRegrid(& + is_local%wrap%FBfrac(compice), 'ofrac', & + is_local%wrap%FBfrac(compocn), 'ofrac', & + is_local%wrap%RH(compice,compocn,mapfcopy), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + ! ------------------------------------------- + ! Set FBfrac(compatm) + ! ------------------------------------------- + if (is_local%wrap%comp_present(compatm)) then + + if (trim(coupling_mode) == 'nems_orig') then + + ! Map 'ifrac' from FBfrac(compice) to FBfrac(compatm) + call shr_nuopc_methods_FB_FieldRegrid(& + is_local%wrap%FBfrac(compice), 'ifrac', & + is_local%wrap%FBfrac(compatm), 'ifrac', & + is_local%wrap%RH(compice,compatm,mapnstod), & + zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_FieldRegrid(& + is_local%wrap%FBfrac(compice), 'ifrac', & + is_local%wrap%FBfrac(compatm), 'ifrac', & + is_local%wrap%RH(compice,compatm,mapconsf), & + zeroregion=ESMF_REGION_SELECT, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Now set ofrac=1-ifrac and lfrac=0 on the atm grid + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ifrac', ifrac, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ofrac = 1.0_R8 - ifrac + lfrac = 0.0_R8 + + else + + ! Map 'ifrac' from FBfrac(compice) to FBfrac(compatm) + if (is_local%wrap%med_coupling_active(compice,compatm)) then + call shr_nuopc_methods_FB_FieldRegrid(& + is_local%wrap%FBfrac(compice), 'ifrac', & + is_local%wrap%FBfrac(compatm), 'ifrac', & + is_local%wrap%RH(compice,compatm,mapconsf), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Map 'ofrac' from FBfrac(compice) to FBfrac(compatm) + if (is_local%wrap%med_coupling_active(compocn,compatm)) then + call shr_nuopc_methods_FB_FieldRegrid(& + is_local%wrap%FBfrac(compice), 'ofrac', & + is_local%wrap%FBfrac(compatm), 'ofrac', & + is_local%wrap%RH(compice,compatm,mapconsf), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Note: 'lfrac' from FBFrac(compatm) is just going to be in the init + if ( is_local%wrap%med_coupling_active(compice,compatm) .and. & + is_local%wrap%med_coupling_active(compocn,compatm) ) then + + if (atm_frac_correct) then + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ifrac', ifrac, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + where (ifrac + ofrac > 0.0_R8) + ifrac = ifrac * ((1.0_R8 - lfrac)/(ofrac+ifrac)) + ofrac = ofrac * ((1.0_R8 - lfrac)/(ofrac+ifrac)) + elsewhere + ifrac = 0.0_R8 + ofrac = 0.0_R8 + end where + endif + endif + + end if + end if + end if + + !--------------------------------------- + ! Diagnostic output + !--------------------------------------- + + do n = 1,ncomps + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBfrac(n), trim(subname) // trim(compname(n))//' frac', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + enddo + + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + end if + + call t_stopf('MED:'//subname) + + end subroutine med_fraction_set + +end module med_fraction_mod diff --git a/src/mediator/med_infodata_mod.F90 b/src/mediator/med_infodata_mod.F90 new file mode 100644 index 00000000..e83e5f71 --- /dev/null +++ b/src/mediator/med_infodata_mod.F90 @@ -0,0 +1,275 @@ +module med_infodata_mod + + ! !DESCRIPTION: A module to get, put, and store some standard scalar data + + ! !USES: + + use med_constants_mod , only: CL, R8 + use esmFlds , only: ncomps + + implicit none + private ! default private + + ! !PUBLIC TYPES: + + public :: med_infodata_type + + ! !PUBLIC MEMBER FUNCTIONS + + public :: med_infodata_GetData ! Get values from infodata object + public :: med_infodata_CopyStateToInfodata + public :: med_infodata_CopyInfodataToState + + ! !PUBLIC DATA MEMBERS: + public :: med_infodata ! instance of infodata datatype + + ! InputInfo derived type + type med_infodata_type + private + + ! Set via components and held fixed after initialization + integer :: nx(ncomps) = -1 ! global nx + integer :: ny(ncomps) = -1 ! global ny + logical :: rofice_present = .false. ! does rof have iceberg coupling on + logical :: rof_prognostic = .false. ! does rof component need input data + logical :: flood_present = .false. ! does rof have flooding on + logical :: iceberg_prognostic = .false. ! does the ice model support icebergs + logical :: glclnd_present = .false. ! does glc have land coupling fields on + logical :: glcocn_present = .false. ! does glc have ocean runoff on + logical :: glcice_present = .false. ! does glc have iceberg coupling on + logical :: glc_coupled_fluxes = .false. ! does glc send fluxes to other components + ! (only relevant if glc_present is .true.) + + ! Set via components and may be time varying + real(R8) :: nextsw_cday = -1.0_R8 ! calendar of next atm shortwave + real(R8) :: precip_fact = 1.0_R8 ! precip factor + + ! Set by mediator and may be time varying + logical :: glc_valid_input = .true. ! is valid accumulated data being sent to prognostic glc + + end type med_infodata_type + + type (med_infodata_type), target :: med_infodata ! single instance for cpl and all comps + + ! used/reused in module + + character(*),parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +CONTAINS +!=============================================================================== + + subroutine med_infodata_CopyStateToInfodata(State, infodata, type, vm, rc) + + use ESMF , only : ESMF_State, ESMF_Field, ESMF_StateItem_Flag + use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_LogWrite + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_STATEITEM_NOTFOUND, operator(==) + use ESMF , only : ESMF_VMBroadCast, ESMF_VM, ESMF_VMGet + use esmFlds , only : compname + use shr_nuopc_scalars_mod , only : flds_scalar_num, flds_scalar_name + use shr_nuopc_scalars_mod , only : flds_scalar_index_nx, flds_scalar_index_ny + use shr_nuopc_scalars_mod , only : flds_scalar_index_nextsw_cday + use shr_nuopc_scalars_mod , only : flds_scalar_index_precip_fact + use shr_nuopc_methods_mod , only : shr_nuopc_methods_chkErr + + ! ---------------------------------------------- + ! Copy scalar data from State to local data on root then broadcast data + ! to all PETs in component. + ! ---------------------------------------------- + + type(ESMF_State), intent(in) :: State + type(med_infodata_type), intent(inout) :: infodata + character(len=*), intent(in) :: type + type(ESMF_VM), intent(inout) :: vm + integer, intent(inout) :: rc + + ! local variables + integer :: n + integer :: mytask, ierr, len + type(ESMF_Field) :: field + type(ESMF_StateItem_Flag) :: itemType + real(R8), pointer :: farrayptr(:,:) + real(R8) :: data(flds_scalar_num) + character(len=32) :: ntype + integer :: dbrc + character(len=1024) :: msgString + character(len=*), parameter :: subname='(med_infodata_CopyStateToInfodata)' + !---------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), itemType=itemType, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (itemType == ESMF_STATEITEM_NOTFOUND) then + call ESMF_LogWrite(trim(subname)//": "//trim(flds_scalar_name)//" not found", ESMF_LOGMSG_INFO, & + line=__LINE__, file=u_FILE_u, rc=dbrc) + else + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (mytask == 0) then + call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (size(data) < flds_scalar_num .or. size(farrayptr) < flds_scalar_num) then + call ESMF_LogWrite(trim(subname)//": ERROR on data size", ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + data(1:flds_scalar_num) = farrayptr(1:flds_scalar_num,1) + endif + + call ESMF_VMBroadCast(vm, data, flds_scalar_num, 0, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1,ncomps + ntype = trim(compname(n))//'2cpli' + if (trim(type) == trim(ntype)) then + infodata%nx(n) = nint(data(flds_scalar_index_nx)) + infodata%ny(n) = nint(data(flds_scalar_index_ny)) + write(msgString,'(2i8,2l4)') nint(data(flds_scalar_index_nx)),nint(data(flds_scalar_index_ny)) + call ESMF_LogWrite(trim(subname)//":"//trim(type)//":"//trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + endif + enddo + + if (type == 'atm2cpli') then + infodata%nextsw_cday = data(flds_scalar_index_nextsw_cday) + elseif (type == 'ocn2cpli') then + infodata%precip_fact=data(flds_scalar_index_precip_fact) + elseif (type == 'atm2cpl') then + infodata%nextsw_cday=data(flds_scalar_index_nextsw_cday) + elseif (type == 'ocn2cpl') then + infodata%precip_fact=data(flds_scalar_index_precip_fact) + endif + + endif + + end subroutine med_infodata_CopyStateToInfodata + + !================================================================================ + + subroutine med_infodata_CopyInfodataToState(infodata, State, type, mytask, rc) + + use ESMF , only : ESMF_State, ESMF_StateGet, ESMF_Field, ESMF_StateItem_Flag, ESMF_FieldGet + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_STATEITEM_NOTFOUND + use ESMF , only : operator(==), ESMF_FAILURE + use shr_nuopc_scalars_mod , only : flds_scalar_num, flds_scalar_name + use shr_nuopc_scalars_mod , only : flds_scalar_index_nx, flds_scalar_index_ny + use shr_nuopc_scalars_mod , only : flds_scalar_index_nextsw_cday + use shr_nuopc_scalars_mod , only : flds_scalar_index_precip_fact + use shr_nuopc_methods_mod , only : shr_nuopc_methods_chkErr + + ! ---------------------------------------------- + ! Copy local scalar data into State, root only, + ! but called on all PETs in component + ! ---------------------------------------------- + + type(med_infodata_type),intent(in):: infodata + type(ESMF_State), intent(inout) :: State + character(len=*), intent(in) :: type + integer , intent(in) :: mytask + integer, intent(inout) :: rc + + ! local variables + type(ESMF_Field) :: field + type(ESMF_StateItem_Flag) :: ItemType + real(R8), pointer :: farrayptr(:,:) + real(R8) :: nextsw_cday, precip_fact + integer :: dbrc + character(len=*), parameter :: subname='(med_infodata_CopyInfodataToState)' + !---------------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), itemType=itemType, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (itemType == ESMF_STATEITEM_NOTFOUND) then + + call ESMF_LogWrite(trim(subname)//": "//trim(flds_scalar_name)//" not found", & + ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u, rc=dbrc) + + else + + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (mytask == 0) then + call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (size(farrayptr) < flds_scalar_num) then + call ESMF_LogWrite(trim(subname)//": ERROR on data size", & + ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + farrayptr(flds_scalar_index_nextsw_cday,1) = infodata%nextsw_cday + farrayptr(flds_scalar_index_precip_fact,1) = infodata%precip_fact + endif + + endif + + end subroutine med_infodata_CopyInfodataToState + + !=============================================================================== + + subroutine med_infodata_GetData( infodata, ncomp, flux_epbal, flux_epbalfact, nx, ny) + + ! Get values out of the infodata object. + + use med_constants_mod , only : CL, IN + use med_internalstate_mod , only : logunit, loglevel + use shr_sys_mod , only : shr_sys_abort + + ! !INPUT/OUTPUT PARAMETERS: + type(med_infodata_type) , intent(IN) :: infodata ! Input CCSM structure + integer(IN), optional , intent(IN) :: ncomp ! Component ID + character(CL), optional , intent(IN) :: flux_epbal ! selects E,P,R adjustment technique + real(R8), optional , intent(OUT) :: flux_epbalfact ! adjusted precip factor + integer(IN), optional , intent(OUT) :: nx ! nx + integer(IN), optional , intent(OUT) :: ny ! ny + + !----- local ----- + character(len=*), parameter :: subname = '(med_infodata_GetData) ' + !------------------------------------------------------------------------------- + + if ( present(flux_epbalfact)) then + if (.not. present(flux_epbal)) then + call shr_sys_abort(subname // "Must provide flux_epbal as an input argument to determine infodata%precip_fact") + end if + + flux_epbalfact = 1.0_R8 + if (trim(flux_epbal) == 'ocn') then + flux_epbalfact = infodata%precip_fact + if (flux_epbalfact <= 0.0_R8) then + if (loglevel > 0) then + write(logunit,'(2a,e16.6)') trim(subname),' WARNING: factor from ocn = ',flux_epbalfact + write(logunit,'(2a)') trim(subname),' WARNING: resetting flux_epbalfact to 1.0' + end if + flux_epbalfact = 1.0_R8 + end if + end if + endif + + if (present(nx)) then + if (.not.present(ncomp)) then + call shr_sys_abort(subname // " Must provide nx") + endif + nx = infodata%nx(ncomp) + endif + + if (present(ny)) then + if (.not.present(ncomp)) then + call shr_sys_abort(subname // "Must provide ny") + endif + ny = infodata%ny(ncomp) + endif + + end subroutine med_infodata_GetData + +end module med_infodata_mod diff --git a/src/mediator/med_internalstate_mod.F90 b/src/mediator/med_internalstate_mod.F90 new file mode 100644 index 00000000..5ad35244 --- /dev/null +++ b/src/mediator/med_internalstate_mod.F90 @@ -0,0 +1,98 @@ +module med_internalstate_mod + + !----------------------------------------------------------------------------- + ! Mediator Internal State Datatype. + !----------------------------------------------------------------------------- + + use ESMF , only : ESMF_RouteHandle, ESMF_FieldBundle, ESMF_State + use ESMF , only : ESMF_VM + use esmFlds , only : ncomps, nmappers + + implicit none + private + + integer, public :: logunit ! logunit for mediator log output + integer, public :: loglevel ! loglevel for mediator log output + logical, public :: mastertask=.false. ! is this the mastertask + integer, public :: med_id ! needed currently in med_io_mod and set in esm.F90 + + ! Active coupling definitions + ! This defines the med_mapping_allowed is a starting point for what is + ! allowed in this coupled system. It will be revised further after the system + ! starts, but any coupling set to false will never be allowed. As new connections + ! are allowed, just update the table below. + ! - the rows are the destination of coupling + ! - the columns are the source of coupling + ! - So, the second column indicates which models the atm is coupled to. + ! - And the second row indicates which models are coupled to the atm. + ! The mediator is not connected to any components because the mediator + ! doesn't have it's own grid and only acts as a hub. + + ! tcraig, turned off glc2ocn and glc2ice for time being + logical, public, parameter :: med_coupling_allowed(ncomps,ncomps) = & + (/ .false., .false., .false., .false., .false., .false., .false., .false., & ! med + .false., .false., .true. , .true. , .true. , .false., .false., .false., & ! atm + .false., .true. , .false., .false., .false., .true. , .false., .true. , & ! lnd + .false., .true. , .false., .false., .true. , .true. , .true. , .false., & ! ocn + .false., .true. , .false., .true. , .false., .true. , .false., .false., & ! ice + .false., .false., .true. , .false., .false., .false., .false., .false., & ! rof + .false., .true. , .false., .true. , .true. , .false., .false., .false., & ! wav + .false., .false., .true. , .false., .false., .false., .false., .false. /) ! glc + ! med atm lnd ocn ice rof wav glc + + ! private internal state to keep instance data + type InternalStateStruct + + ! NState_Imp and NState_Exp are the standard NUOPC coupling datatypes + ! FBImp and FBExp are the internal mediator datatypes + ! NState_Exp(n) = FBExp(n), copied in the connector prep phase + ! FBImp(n,n) = NState_Imp(n), copied in connector post phase + ! FBImp(n,k) is the FBImp(n,n) interpolated to grid k + ! RH(n,k,m) is a RH from grid n to grid k, map type m + + ! Present/Active logical flags + logical :: comp_present(ncomps) ! comp present flag + logical :: med_coupling_active(ncomps,ncomps) ! computes the active coupling + + ! Import/export States and field bundles + type(ESMF_State) :: NStateImp(ncomps) ! Import data from various component, on their grid + type(ESMF_State) :: NStateExp(ncomps) ! Export data to various component, on their grid + type(ESMF_FieldBundle) :: FBImp(ncomps,ncomps) ! Import data from various components interpolated to various grids + type(ESMF_FieldBundle) :: FBExp(ncomps) ! Export data for various components, on their grid + + ! Mediator field bundles + type(ESMF_FieldBundle) :: FBMed_ocnalb_o ! Ocn albedo on ocn grid + type(ESMF_FieldBundle) :: FBMed_ocnalb_a ! Ocn albedo on atm grid + type(ESMF_FieldBundle) :: FBMed_aoflux_o ! Ocn/Atm flux fields on ocn grid + type(ESMF_FieldBundle) :: FBMed_aoflux_a ! Ocn/Atm flux fields on atm grid + + ! Mapping + type(ESMF_RouteHandle) :: RH(ncomps,ncomps,nmappers) ! Routehandles for pairs of components and different mappers + type(ESMF_FieldBundle) :: FBNormOne(ncomps,ncomps,nmappers) ! Unity static normalization + + ! Fractions + type(ESMF_FieldBundle) :: FBfrac(ncomps) ! Fraction data for various components, on their grid + + ! Accumulators for export field bundles + type(ESMF_FieldBundle) :: FBExpAccum(ncomps) ! Accumulator for various components export on their grid + integer :: FBExpAccumCnt(ncomps) ! Accumulator counter for each FBExpAccum + logical :: FBExpAccumFlag(ncomps) = .false. ! Accumulator flag, if true accumulation was done + + ! Accumulators for import field bundles + type(ESMF_FieldBundle) :: FBImpAccum(ncomps,ncomps) ! Accumulator for various components import + integer :: FBImpAccumCnt(ncomps) ! Accumulator counter for each FBImpAccum + + ! Connectors + integer :: conn_prep_cnt(ncomps) ! Connector prep count + integer :: conn_post_cnt(ncomps) ! Connector post count + type(ESMF_VM) :: vm + + end type InternalStateStruct + + type, public :: InternalState + type(InternalStateStruct), pointer :: wrap + end type InternalState + + !----------------------------------------------------------------------------- + +end module med_internalstate_mod diff --git a/src/mediator/med_io_mod.F90 b/src/mediator/med_io_mod.F90 new file mode 100644 index 00000000..9c802883 --- /dev/null +++ b/src/mediator/med_io_mod.F90 @@ -0,0 +1,1391 @@ +module med_io_mod + ! !DESCRIPTION: Writes attribute vectors to netcdf + + ! !USES: + use ESMF, only : ESMF_VM + use med_constants_mod , only : CL + use pio, only : file_desc_t, iosystem_desc_t + use shr_nuopc_utils_mod, only : shr_nuopc_utils_ChkErr + implicit none + private + + ! public member functions: + public med_io_wopen + public med_io_close + public med_io_redef + public med_io_enddef + public med_io_date2yyyymmdd + public med_io_sec2hms + public med_io_read + public med_io_write + public med_io_init + + ! public data members: + interface med_io_read + module procedure med_io_read_FB + module procedure med_io_read_int + module procedure med_io_read_int1d + module procedure med_io_read_r8 + module procedure med_io_read_r81d + module procedure med_io_read_char + end interface med_io_read + interface med_io_write + module procedure med_io_write_FB + module procedure med_io_write_int + module procedure med_io_write_int1d + module procedure med_io_write_r8 + module procedure med_io_write_r81d + module procedure med_io_write_char + module procedure med_io_write_time + end interface med_io_write + + !------------------------------------------------------------------------------- + ! Local data + !------------------------------------------------------------------------------- + + character(*),parameter :: prefix = "med_io_" + character(*),parameter :: modName = "(med_io_mod) " + character(*),parameter :: version = "cmeps0" + + integer , parameter :: file_desc_t_cnt = 20 ! Note - this is hard-wired for now + character(*),parameter :: u_file_u = & + __FILE__ + + character(CL) :: wfilename = '' + type(file_desc_t) :: io_file(0:file_desc_t_cnt) + integer :: pio_iotype + integer :: pio_ioformat + type(iosystem_desc_t), pointer :: io_subsystem + +!================================================================================= +contains +!================================================================================= + + logical function med_io_file_exists(vm, iam, filename) + + !--------------- + ! inquire if i/o file exists + !--------------- + + use ESMF, only : ESMF_VMBroadCast + + type(ESMF_VM) :: vm + integer, intent(in) :: iam + character(len=*), intent(in) :: filename + + logical :: exists + integer :: tmp(1) + integer :: rc + + med_io_file_exists = .false. + if (iam==0) inquire(file=trim(filename),exist=med_io_file_exists) + if (med_io_file_exists) tmp(1) = 1 + + call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if(tmp(1) == 1) med_io_file_exists = .true. + + end function med_io_file_exists + + !=============================================================================== + subroutine med_io_init() + + !--------------- + ! initialize pio + !--------------- + + use shr_pio_mod , only : shr_pio_getiosys, shr_pio_getiotype, shr_pio_getioformat + use med_internalstate_mod , only : med_id + + io_subsystem => shr_pio_getiosys(med_id) + pio_iotype = shr_pio_getiotype(med_id) + pio_ioformat = shr_pio_getioformat(med_id) + + end subroutine med_io_init + + !=============================================================================== + subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) + + !--------------- + ! open netcdf file + !--------------- + + use pio , only : PIO_IOTYPE_PNETCDF, PIO_IOTYPE_NETCDF, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR + use pio , only : pio_openfile, pio_createfile, PIO_GLOBAL, pio_enddef + use PIO , only : pio_put_att, pio_redef, pio_get_att + use pio , only : pio_seterrorhandling, pio_file_is_open, pio_clobber, pio_write, pio_noclobber + use shr_sys_mod , only : shr_sys_abort + use med_internalstate_mod , only : logunit + + ! input/output arguments + character(*), intent(in) :: filename + type(ESMF_VM) :: vm + integer, intent(in) :: iam + logical, optional, intent(in) :: clobber + integer, optional, intent(in) :: file_ind + character(CL), optional, intent(in) :: model_doi_url + + ! local variables + logical :: exists + logical :: lclobber + integer :: tmp(1) + integer :: rcode + integer :: nmode + integer :: lfile_ind + integer :: rc + character(CL) :: lversion + character(CL) :: lmodel_doi_url + character(*),parameter :: subName = '(med_io_wopen) ' + !------------------------------------------------------------------------------- + + lversion=trim(version) + + lclobber = .false. + if (present(clobber)) lclobber=clobber + + lmodel_doi_url = 'unset' + if (present(model_doi_url)) lmodel_doi_url = model_doi_url + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + if (.not. pio_file_is_open(io_file(lfile_ind))) then + + ! filename not open + wfilename = filename + + if (med_io_file_exists(vm, iam, filename)) then + if (lclobber) then + nmode = pio_clobber + ! only applies to classic NETCDF files. + if(pio_iotype == PIO_IOTYPE_NETCDF .or. pio_iotype == PIO_IOTYPE_PNETCDF) then + nmode = ior(nmode,pio_ioformat) + endif + rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) + if(iam==0) write(logunit,*) subname,' create file ',trim(filename) + rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) + rcode = pio_put_att(io_file(lfile_ind),pio_global,"model_doi_url",lmodel_doi_url) + else + rcode = pio_openfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), pio_write) + if (iam==0) then + write(logunit,*) subname,' open file ',trim(filename) + end if + call pio_seterrorhandling(io_file(lfile_ind),PIO_BCAST_ERROR) + rcode = pio_get_att(io_file(lfile_ind),pio_global,"file_version",lversion) + call pio_seterrorhandling(io_file(lfile_ind),PIO_INTERNAL_ERROR) + if (trim(lversion) /= trim(version)) then + rcode = pio_redef(io_file(lfile_ind)) + rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) + rcode = pio_enddef(io_file(lfile_ind)) + endif + endif + else + nmode = pio_noclobber + ! only applies to classic NETCDF files. + if(pio_iotype == PIO_IOTYPE_NETCDF .or. pio_iotype == PIO_IOTYPE_PNETCDF) then + nmode = ior(nmode,pio_ioformat) + endif + rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) + if (iam==0) then + write(logunit,*) subname,' create file ',trim(filename) + end if + rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) + rcode = pio_put_att(io_file(lfile_ind),pio_global,"model_doi_url",lmodel_doi_url) + endif + elseif (trim(wfilename) /= trim(filename)) then + ! filename is open, better match open filename + if(iam==0) write(logunit,*) subname,' different filename currently open ',trim(filename) + if(iam==0) write(logunit,*) subname,' different wfilename currently open ',trim(wfilename) + call shr_sys_abort(subname//'different file currently open '//trim(filename)) + else + ! filename is already open, just return + endif + + end subroutine med_io_wopen + + !=============================================================================== + subroutine med_io_close(filename, iam, file_ind) + + use pio, only: pio_file_is_open, pio_closefile + use med_internalstate_mod, only : logunit + use shr_sys_mod, only : shr_sys_abort + + ! !DESCRIPTION: close netcdf file + + ! input/output variables + character(*), intent(in) :: filename + integer, intent(in) :: iam + integer,optional, intent(in) :: file_ind + + ! local variables + integer :: lfile_ind + character(*),parameter :: subName = '(med_io_close) ' + !------------------------------------------------------------------------------- + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + if (.not. pio_file_is_open(io_file(lfile_ind))) then + ! filename not open, just return + elseif (trim(wfilename) == trim(filename)) then + ! filename matches, close it + call pio_closefile(io_file(lfile_ind)) + else + ! different filename is open, abort + if (iam==0) write(logunit,*) subname,' different filename currently open, aborting ',trim(filename) + if (iam==0) write(logunit,*) subname,' different wfilename currently open, aborting ',trim(wfilename) + call shr_sys_abort(subname//'different file currently open, aborting '//trim(filename)) + endif + wfilename = '' + end subroutine med_io_close + + !=============================================================================== + subroutine med_io_redef(filename,file_ind) + use pio, only : pio_redef + character(len=*), intent(in) :: filename + integer,optional,intent(in):: file_ind + + integer :: lfile_ind + integer :: rcode + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + rcode = pio_redef(io_file(lfile_ind)) + end subroutine med_io_redef + + !=============================================================================== + subroutine med_io_enddef(filename,file_ind) + use med_internalstate_mod, only : logunit + use pio, only : pio_enddef + character(len=*), intent(in) :: filename + integer,optional,intent(in):: file_ind + integer :: lfile_ind + integer :: rcode + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + rcode = pio_enddef(io_file(lfile_ind)) + end subroutine med_io_enddef + + !=============================================================================== + character(len=24) function med_io_date2yyyymmdd (date) + use shr_cal_mod, only : shr_cal_datetod2string + ! input arguments + integer, intent(in) :: date ! date expressed as an integer: yyyymmdd + !---------------------------------------------------------------------- + + call shr_cal_datetod2string(date_str = med_io_date2yyyymmdd, ymd = date) + end function med_io_date2yyyymmdd + + !=============================================================================== + character(len=8) function med_io_sec2hms (seconds) + use shr_sys_mod, only : shr_sys_abort + use med_internalstate_mod , only : logunit + ! Input arguments + integer, intent(in) :: seconds + + ! Local workspace + integer :: hours ! hours of hh:mm:ss + integer :: minutes ! minutes of hh:mm:ss + integer :: secs ! seconds of hh:mm:ss + !---------------------------------------------------------------------- + + if (seconds < 0 .or. seconds > 86400) then + write(logunit,*)'med_io_sec2hms: bad input seconds:', seconds + call shr_sys_abort('med_io_sec2hms: bad input seconds') + end if + + hours = seconds / 3600 + minutes = (seconds - hours*3600) / 60 + secs = (seconds - hours*3600 - minutes*60) + + if (minutes < 0 .or. minutes > 60) then + write(logunit,*)'med_io_sec2hms: bad minutes = ',minutes + call shr_sys_abort('med_io_sec2hms: bad minutes') + end if + + if (secs < 0 .or. secs > 60) then + write(logunit,*)'med_io_sec2hms: bad secs = ',secs + call shr_sys_abort('med_io_sec2hms: bad secs') + end if + + write(med_io_sec2hms,80) hours, minutes, secs +80 format(i2.2,':',i2.2,':',i2.2) + + end function med_io_sec2hms + + !=============================================================================== + subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & + fillval, pre, tavg, use_float, file_ind, rc) + + ! !DESCRIPTION: Write FB to netcdf file + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundle, ESMF_Field, ESMF_Mesh, ESMF_DistGrid + use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_MeshGet, ESMF_DistGridGet +! use ESMF , only : ESMF_VMGetCurrent, ESMF_VMGet + use med_constants_mod , only : R4, R8 + use shr_const_mod , only : fillvalue=>SHR_CONST_SPVAL + use pio , only : var_desc_t, io_desc_t, pio_offset_kind + use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFieldN + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFldPtr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNameN + use esmFlds , only : shr_nuopc_fldList_GetMetadata + use pio , only : pio_def_dim, pio_inq_dimid, pio_real, pio_def_var, pio_put_att, pio_double + use pio , only : pio_inq_varid, pio_setframe, pio_write_darray, pio_initdecomp, pio_freedecomp + use pio , only : pio_syncfile + ! input/output variables + character(len=*), intent(in) :: filename ! file + integer, intent(in) :: iam ! local pet + type(ESMF_FieldBundle), intent(in) :: FB ! data to be written + logical, optional, intent(in) :: whead ! write header + logical, optional, intent(in) :: wdata ! write data + integer , optional, intent(in) :: nx ! 2d grid size if available + integer , optional, intent(in) :: ny ! 2d grid size if available + integer , optional, intent(in) :: nt ! time sample + real(r8), optional, intent(in) :: fillval ! fill value + character(len=*), optional, intent(in) :: pre ! prefix to variable name + logical, optional, intent(in) :: tavg ! is this a tavg + logical, optional, intent(in) :: use_float ! write output as float rather than double + integer, optional, intent(in) :: file_ind + integer, intent(out):: rc + + ! local variables + type(ESMF_Field) :: field + type(ESMF_Mesh) :: mesh + type(ESMF_Distgrid) :: distgrid + type(ESMF_VM) :: VM + integer :: mpicom + integer :: rcode + integer :: nf,ns,ng + integer :: k + integer ,target :: dimid2(2) + integer ,target :: dimid3(3) + integer ,pointer :: dimid(:) + type(var_desc_t) :: varid + type(io_desc_t) :: iodesc + integer(kind=Pio_Offset_Kind) :: frame + character(CL) :: itemc ! string converted to char + character(CL) :: name1 ! var name + character(CL) :: cunit ! var units + character(CL) :: lname ! long name + character(CL) :: sname ! standard name + character(CL) :: lpre ! local prefix + logical :: lwhead, lwdata + logical :: luse_float + integer :: lnx,lny + real(r8) :: lfillvalue + integer, pointer :: minIndexPTile(:,:) + integer, pointer :: maxIndexPTile(:,:) + integer :: dimCount, tileCount + integer, pointer :: Dof(:) + integer :: lfile_ind + real(r8), pointer :: fldptr1(:), tmpfldptr(:) + character(CL) :: tmpstr + integer :: dbrc + character(*),parameter :: subName = '(med_io_write_FB) ' + !------------------------------------------------------------------------------- + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + endif + rc = ESMF_Success + +! call ESMF_VMGetCurrent(vm, rc=rc) +! call ESMF_VMGet(vm, mpiCommunicator=mpicom, rc=rc) + + lfillvalue = fillvalue + if (present(fillval)) then + lfillvalue = fillval + endif + + lpre = ' ' + if (present(pre)) then + lpre = trim(pre) + endif + + if (.not. ESMF_FieldBundleIsCreated(FB,rc=rc)) then + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO, rc=rc) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + endif + rc = ESMF_Success + return + endif + + lwhead = .true. + lwdata = .true. + if (present(whead)) lwhead = whead + if (present(wdata)) lwdata = wdata + + if (.not.lwhead .and. .not.lwdata) then + ! should we write a warning? + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + endif + return + endif + + luse_float = .false. + if (present(use_float)) luse_float = use_float + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + call ESMF_FieldBundleGet(FB, fieldCount=nf, rc=rc) + write(tmpstr,*) subname//' field count = '//trim(lpre),nf + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (nf < 1) then + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" empty", ESMF_LOGMSG_INFO, rc=rc) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + endif + rc = ESMF_Success + return + endif + + call shr_nuopc_methods_FB_getFieldN(FB, 1, field, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(field, mesh=mesh, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + allocate(minIndexPTile(dimCount, tileCount), maxIndexPTile(dimCount, tileCount)) + call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, maxIndexPTile=maxIndexPTile, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + ! write(tmpstr,*) subname,' counts = ',dimcount,tilecount,minindexptile,maxindexptile + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + ! TODO: this is not getting the global size correct for a FB coming in that does not have + ! all the global grid values in the distgrid - e.g. CTSM + + ng = maxval(maxIndexPTile) + lnx = ng + lny = 1 + deallocate(minIndexPTile, maxIndexPTile) + + frame = -1 + if (present(nt)) then + frame = nt + endif + if (present(nx)) then + if (nx >= 0) lnx = nx + endif + if (present(ny)) then + if (ny >= 0) lny = ny + endif + if (lnx*lny /= ng) then + write(tmpstr,*) subname,' ERROR: grid2d size not consistent ',ng,lnx,lny + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + !TODO: this should not be an error for say CTSM which does not send a global grid + !rc = ESMF_FAILURE + !return + endif + + if (lwhead) then + rcode = pio_def_dim(io_file(lfile_ind),trim(lpre)//'_nx',lnx,dimid2(1)) + rcode = pio_def_dim(io_file(lfile_ind),trim(lpre)//'_ny',lny,dimid2(2)) + + if (present(nt)) then + dimid3(1:2) = dimid2 + rcode = pio_inq_dimid(io_file(lfile_ind),'time',dimid3(3)) + dimid => dimid3 + else + dimid => dimid2 + endif + + write(tmpstr,*) subname,' tcx dimid = ',dimid + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + do k = 1,nf + call shr_nuopc_methods_FB_getNameN(FB, k, itemc, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + !-------tcraig, this is a temporary mod to NOT write hgt + if (trim(itemc) /= "hgt") then + name1 = trim(lpre)//'_'//trim(itemc) + call shr_nuopc_fldList_GetMetadata(itemc,longname=lname,stdname=sname,units=cunit) + call ESMF_LogWrite(trim(subname)//':'//trim(itemc)//':'//trim(name1),ESMF_LOGMSG_INFO, rc=rc) + if (luse_float) then + rcode = pio_def_var(io_file(lfile_ind),trim(name1),PIO_REAL,dimid,varid) + rcode = pio_put_att(io_file(lfile_ind),varid,"_FillValue",real(lfillvalue,r4)) + else + rcode = pio_def_var(io_file(lfile_ind),trim(name1),PIO_DOUBLE,dimid,varid) + rcode = pio_put_att(io_file(lfile_ind),varid,"_FillValue",lfillvalue) + end if + rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file(lfile_ind),varid,"long_name",trim(lname)) + rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(sname)) + if (present(tavg)) then + if (tavg) then + rcode = pio_put_att(io_file(lfile_ind),varid,"cell_methods","time: mean") + endif + endif + endif + !-------tcraig + enddo + if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) + end if + + if (lwdata) then + ! use distgrid extracted from field 1 above + call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + allocate(dof(ns)) + call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) + write(tmpstr,*) subname,' dof = ',ns,size(dof),dof(1),dof(ns) !,minval(dof),maxval(dof) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) + +! call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom) + + deallocate(dof) + + do k = 1,nf + call shr_nuopc_methods_FB_getNameN(FB, k, itemc, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_getFldPtr(FB, itemc, fldptr1=fldptr1, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + !-------tcraig, this is a temporary mod to NOT write hgt + if (trim(itemc) /= "hgt") then + name1 = trim(lpre)//'_'//trim(itemc) + rcode = pio_inq_varid(io_file(lfile_ind),trim(name1),varid) + call pio_setframe(io_file(lfile_ind),varid,frame) + call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr1, rcode, fillval=lfillvalue) + !-------tcraig + endif + enddo + call pio_syncfile(io_file(lfile_ind)) + + call pio_freedecomp(io_file(lfile_ind), iodesc) + endif + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + endif + + end subroutine med_io_write_FB + + !=============================================================================== + subroutine med_io_write_int(filename, iam, idata, dname, whead, wdata, file_ind) + + use pio , only : var_desc_t, pio_def_var, pio_put_att, pio_int, pio_inq_varid, pio_put_var + use esmFlds, only : shr_nuopc_fldList_GetMetadata + + ! !DESCRIPTION: Write scalar integer to netcdf file + + ! intput/output variables + character(len=*),intent(in) :: filename ! file + integer ,intent(in) :: iam ! local pet + integer ,intent(in) :: idata ! data to be written + character(len=*),intent(in) :: dname ! name of data + logical,optional,intent(in) :: whead ! write header + logical,optional,intent(in) :: wdata ! write data + integer,optional,intent(in) :: file_ind + + ! local variables + integer :: rcode + type(var_desc_t) :: varid + character(CL) :: cunit ! var units + character(CL) :: lname ! long name + character(CL) :: sname ! standard name + logical :: lwhead, lwdata + integer :: lfile_ind + character(*),parameter :: subName = '(med_io_write_int) ' + !------------------------------------------------------------------------------- + + lwhead = .true. + lwdata = .true. + if (present(whead)) lwhead = whead + if (present(wdata)) lwdata = wdata + + if (.not.lwhead .and. .not.lwdata) then + ! should we write a warning? + return + endif + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + if (lwhead) then + call shr_nuopc_fldList_GetMetadata(trim(dname),longname=lname,stdname=sname,units=cunit) + ! rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_nx',1,dimid(1)) + ! rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_INT,dimid,varid) + rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_INT,varid) + rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file(lfile_ind),varid,"long_name",trim(lname)) + rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(sname)) + if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) + endif + + if (lwdata) then + rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) + rcode = pio_put_var(io_file(lfile_ind),varid,idata) + ! write(logunit,*) subname,' wrote AV ',trim(dname),lwhead,lwdata + endif + + end subroutine med_io_write_int + + !=============================================================================== + subroutine med_io_write_int1d(filename, iam, idata, dname, whead, wdata, file_ind) + + use pio , only : var_desc_t, pio_def_dim, pio_def_var + use pio , only : pio_put_att, pio_inq_varid, pio_put_var + use pio , only : pio_int, pio_def_var + use esmFlds , only : shr_nuopc_fldList_GetMetadata + + ! !DESCRIPTION: Write 1d integer array to netcdf file + + ! input/output arguments + character(len=*),intent(in) :: filename ! file + integer ,intent(in) :: iam ! local pet + integer ,intent(in) :: idata(:) ! data to be written + character(len=*),intent(in) :: dname ! name of data + logical,optional,intent(in) :: whead ! write header + logical,optional,intent(in) :: wdata ! write data + integer,optional,intent(in) :: file_ind + + ! local variables + integer :: rcode + integer :: dimid(1) + type(var_desc_t) :: varid + character(CL) :: cunit ! var units + character(CL) :: lname ! long name + character(CL) :: sname ! standard name + integer :: lnx + logical :: lwhead, lwdata + integer :: lfile_ind + character(*),parameter :: subName = '(med_io_write_int1d) ' + !------------------------------------------------------------------------------- + + lwhead = .true. + lwdata = .true. + if (present(whead)) lwhead = whead + if (present(wdata)) lwdata = wdata + + if (.not.lwhead .and. .not.lwdata) then + ! should we write a warning? + return + endif + + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + if (lwhead) then + call shr_nuopc_fldList_GetMetadata(trim(dname),longname=lname,stdname=sname,units=cunit) + lnx = size(idata) + rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_nx',lnx,dimid(1)) + rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_INT,dimid,varid) + rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file(lfile_ind),varid,"long_name",trim(lname)) + rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(sname)) + if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) + endif + + if (lwdata) then + rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) + rcode = pio_put_var(io_file(lfile_ind),varid,idata) + endif + + ! write(logunit,*) subname,' wrote AV ',trim(dname),lwhead,lwdata + + end subroutine med_io_write_int1d + + !=============================================================================== + subroutine med_io_write_r8(filename, iam, rdata, dname, whead, wdata, file_ind) + + use med_constants_mod , only : R8 + use pio , only : var_desc_t, pio_def_var, pio_put_att + use pio , only : pio_double, pio_noerr, pio_inq_varid, pio_put_var + use esmFlds , only : shr_nuopc_fldList_GetMetadata + + ! !DESCRIPTION: Write scalar double to netcdf file + + ! input/output arguments + character(len=*),intent(in) :: filename ! file + integer ,intent(in) :: iam ! local pet + real(r8) ,intent(in) :: rdata ! data to be written + character(len=*),intent(in) :: dname ! name of data + logical,optional,intent(in) :: whead ! write header + logical,optional,intent(in) :: wdata ! write data + integer,optional,intent(in) :: file_ind + + ! local variables + integer :: rcode + type(var_desc_t) :: varid + character(CL) :: cunit ! var units + character(CL) :: lname ! long name + character(CL) :: sname ! standard name + logical :: lwhead, lwdata + integer :: lfile_ind + character(*),parameter :: subName = '(med_io_write_r8) ' + !------------------------------------------------------------------------------- + + lwhead = .true. + if (present(whead)) lwhead = whead + lwdata = .true. + if (present(wdata)) lwdata = wdata + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + if (.not.lwhead .and. .not.lwdata) then + ! should we write a warning? + return + endif + + if (lwhead) then + call shr_nuopc_fldList_GetMetadata(trim(dname),longname=lname,stdname=sname,units=cunit) + ! rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_nx',1,dimid(1)) + ! rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,dimid,varid) + rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,varid) + if(rcode==PIO_NOERR) then + rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file(lfile_ind),varid,"long_name",trim(lname)) + rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(sname)) + if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) + end if + endif + + if (lwdata) then + rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) + rcode = pio_put_var(io_file(lfile_ind),varid,rdata) + endif + + end subroutine med_io_write_r8 + + !=============================================================================== + subroutine med_io_write_r81d(filename, iam, rdata, dname, whead, wdata, file_ind) + + ! !DESCRIPTION: Write 1d double array to netcdf file + + use med_constants_mod , only : R8 + use pio , only : var_desc_t, pio_def_dim, pio_def_var + use pio , only : pio_inq_varid, pio_put_var, pio_double, pio_put_att + use esmFlds , only : shr_nuopc_fldList_GetMetadata + + ! !INPUT/OUTPUT PARAMETERS: + character(len=*),intent(in) :: filename ! file + integer ,intent(in) :: iam + real(r8) ,intent(in) :: rdata(:) ! data to be written + character(len=*),intent(in) :: dname ! name of data + logical,optional,intent(in) :: whead ! write header + logical,optional,intent(in) :: wdata ! write data + integer,optional,intent(in) :: file_ind + + ! local variables + integer :: rcode + integer :: dimid(1) + type(var_desc_t) :: varid + character(CL) :: cunit ! var units + character(CL) :: lname ! long name + character(CL) :: sname ! standard name + integer :: lnx + logical :: lwhead, lwdata + integer :: lfile_ind + character(*),parameter :: subName = '(med_io_write_r81d) ' + !------------------------------------------------------------------------------- + + lwhead = .true. + if (present(whead)) lwhead = whead + lwdata = .true. + if (present(wdata)) lwdata = wdata + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + + if (.not.lwhead .and. .not.lwdata) then + ! should we write a warning? + return + endif + + if (lwhead) then + call shr_nuopc_fldList_GetMetadata(trim(dname),longname=lname,stdname=sname,units=cunit) + lnx = size(rdata) + rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_nx',lnx,dimid(1)) + rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,dimid,varid) + rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file(lfile_ind),varid,"long_name",trim(lname)) + rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(sname)) + if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) + endif + + if (lwdata) then + rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) + rcode = pio_put_var(io_file(lfile_ind),varid,rdata) + endif + + end subroutine med_io_write_r81d + + !=============================================================================== + subroutine med_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind) + + ! !DESCRIPTION: Write char string to netcdf file + + use pio , only : var_desc_t, pio_def_dim, pio_put_att, pio_def_var, pio_inq_varid + use pio , only : pio_char, pio_put_var + use esmFlds , only : shr_nuopc_fldList_GetMetadata + + ! input/output arguments + character(len=*),intent(in) :: filename ! file + integer ,intent(in) :: iam ! local pet + character(len=*),intent(in) :: rdata ! data to be written + character(len=*),intent(in) :: dname ! name of data + logical,optional,intent(in) :: whead ! write header + logical,optional,intent(in) :: wdata ! write data + integer,optional,intent(in) :: file_ind + + ! local variables + integer :: rcode + integer :: dimid(1) + type(var_desc_t) :: varid + character(CL) :: cunit ! var units + character(CL) :: lname ! long name + character(CL) :: sname ! standard name + integer :: lnx + logical :: lwhead, lwdata + integer :: lfile_ind + character(CL) :: charvar ! buffer for string read/write + character(*),parameter :: subName = '(med_io_write_char) ' + !------------------------------------------------------------------------------- + + lwhead = .true. + if (present(whead)) lwhead = whead + lwdata = .true. + if (present(wdata)) lwdata = wdata + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + if (.not.lwhead .and. .not.lwdata) then + ! should we write a warning? + return + endif + + if (lwhead) then + call shr_nuopc_fldList_GetMetadata(trim(dname),longname=lname,stdname=sname,units=cunit) + lnx = len(charvar) + rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_len',lnx,dimid(1)) + rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_CHAR,dimid,varid) + rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file(lfile_ind),varid,"long_name",trim(lname)) + rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(sname)) + if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) + endif + if (lwdata) then + charvar = '' + charvar = trim(rdata) + rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) + rcode = pio_put_var(io_file(lfile_ind),varid,charvar) + endif + + end subroutine med_io_write_char + + !=============================================================================== + subroutine med_io_write_time(filename, iam, time_units, time_cal, time_val, nt,& + whead, wdata, tbnds, file_ind) + + use med_constants_mod , only : R8 + use shr_cal_mod , only : shr_cal_calMaxLen + use shr_cal_mod , only : shr_cal_noleap + use shr_cal_mod , only : shr_cal_gregorian + use shr_cal_mod , only : shr_cal_calendarName + use pio , only : var_desc_t, PIO_UNLIMITED + use pio , only : pio_double, pio_def_dim, pio_def_var, pio_put_att + use pio , only : pio_inq_varid, pio_put_var + + ! !DESCRIPTION: Write time variable to netcdf file + + ! input/output variables + character(len=*), intent(in) :: filename ! file + integer, intent(in) :: iam ! local pet + character(len=*), intent(in) :: time_units ! units of time + character(len=*), intent(in) :: time_cal ! calendar type + real(r8) , intent(in) :: time_val ! data to be written + integer , optional, intent(in) :: nt + logical, optional, intent(in) :: whead ! write header + logical, optional, intent(in) :: wdata ! write data + real(r8), optional, intent(in) :: tbnds(2) ! time bounds + integer, optional, intent(in) :: file_ind + + ! local variables + integer :: rcode + integer :: dimid(1) + integer :: dimid2(2) + type(var_desc_t) :: varid + logical :: lwhead, lwdata + integer :: start(4),count(4) + character(len=shr_cal_calMaxLen) :: lcalendar + real(r8) :: time_val_1d(1) + integer :: lfile_ind + character(*),parameter :: subName = '(med_io_write_time) ' + !------------------------------------------------------------------------------- + + lwhead = .true. + if (present(whead)) lwhead = whead + lwdata = .true. + if (present(wdata)) lwdata = wdata + lfile_ind = 0 + if (present(file_ind)) lfile_ind=file_ind + if (.not.lwhead .and. .not.lwdata) then + ! should we write a warning? + return + endif + + ! Write out header + if (lwhead) then + rcode = pio_def_dim(io_file(lfile_ind),'time',PIO_UNLIMITED,dimid(1)) + rcode = pio_def_var(io_file(lfile_ind),'time',PIO_DOUBLE,dimid,varid) + rcode = pio_put_att(io_file(lfile_ind),varid,'units',trim(time_units)) + + lcalendar = shr_cal_calendarName(time_cal,trap=.false.) + if (trim(lcalendar) == trim(shr_cal_noleap)) then + lcalendar = 'noleap' + elseif (trim(lcalendar) == trim(shr_cal_gregorian)) then + lcalendar = 'gregorian' + endif + rcode = pio_put_att(io_file(lfile_ind),varid,'calendar',trim(lcalendar)) + + if (present(tbnds)) then + dimid2(2) = dimid(1) + rcode = pio_put_att(io_file(lfile_ind),varid,'bounds','time_bnds') + rcode = pio_def_dim(io_file(lfile_ind),'ntb',2,dimid2(1)) + rcode = pio_def_var(io_file(lfile_ind),'time_bnds',PIO_DOUBLE,dimid2,varid) + endif + if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) + endif + + ! Write out data + if (lwdata) then + start = 1 + count = 1 + if (present(nt)) then + start(1) = nt + endif + time_val_1d(1) = time_val + rcode = pio_inq_varid(io_file(lfile_ind),'time',varid) + rcode = pio_put_var(io_file(lfile_ind),varid,start,count,time_val_1d) + if (present(tbnds)) then + rcode = pio_inq_varid(io_file(lfile_ind),'time_bnds',varid) + start = 1 + count = 1 + if (present(nt)) then + start(2) = nt + endif + count(1) = 2 + rcode = pio_put_var(io_file(lfile_ind),varid,start,count,tbnds) + endif + endif + + end subroutine med_io_write_time + + !=============================================================================== + subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) + + use med_constants_mod , only : R8, CL + use shr_const_mod , only : fillvalue=>SHR_CONST_SPVAL + use ESMF , only : ESMF_FieldBundle, ESMF_Field, ESMF_Mesh, ESMF_DistGrid + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE + use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet + use ESMF , only : ESMF_FieldGet, ESMF_MeshGet, ESMF_DistGridGet + use pio , only : file_desc_T, var_desc_t, io_desc_t, pio_nowrite, pio_openfile + use pio , only : pio_noerr, pio_inq_varndims, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR + use pio , only : pio_inq_dimid, pio_inq_dimlen, pio_inq_varid, pio_inq_vardimid + use pio , only : pio_double, pio_get_att, pio_seterrorhandling, pio_freedecomp, pio_closefile + use pio , only : pio_read_darray, pio_initdecomp, pio_offset_kind + use pio , only : pio_setframe + use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNameN + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFldPtr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFieldN + + ! !DESCRIPTION: Read FB to netcdf file + + ! !input/output arguments + character(len=*) ,intent(in) :: filename ! file + type(ESMF_VM) :: vm + integer ,intent(in) :: iam + type(ESMF_FieldBundle) ,intent(in) :: FB ! data to be read + character(len=*),optional ,intent(in) :: pre ! prefix to variable name + integer(kind=PIO_OFFSET_KIND),optional ,intent(in) :: frame + integer ,intent(out) :: rc + + ! local variables + + type(ESMF_Field) :: field + type(ESMF_Mesh) :: mesh + type(ESMF_Distgrid) :: distgrid + integer :: rcode + integer :: nf,ns,ng + integer :: k,n,ndims + integer, pointer :: dimid(:) + type(file_desc_t) :: pioid + type(var_desc_t) :: varid + type(io_desc_t) :: iodesc + character(CL) :: itemc ! string converted to char + character(CL) :: name1 ! var name + character(CL) :: lpre ! local prefix + integer :: lnx,lny + real(r8) :: lfillvalue + logical :: exists + integer :: tmp(1) + integer, pointer :: minIndexPTile(:,:) + integer, pointer :: maxIndexPTile(:,:) + integer :: dimCount, tileCount + integer, pointer :: Dof(:) + real(r8), pointer :: fldptr1(:) + character(CL) :: tmpstr + integer(kind=Pio_Offset_Kind) :: lframe + character(*),parameter :: subName = '(med_io_read_FB) ' + !------------------------------------------------------------------------------- + rc = ESMF_Success + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + lpre = ' ' + if (present(pre)) then + lpre = trim(pre) + endif + if (present(frame)) then + lframe = frame + else + lframe = 1 + endif + if (.not. ESMF_FieldBundleIsCreated(FB,rc=rc)) then + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + return + endif + + call ESMF_FieldBundleGet(FB, fieldCount=nf, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write(tmpstr,*) subname//' field count = '//trim(lpre),nf + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (nf < 1) then + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" empty", ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + return + endif + + if (med_io_file_exists(vm, iam, trim(filename))) then + rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) + call ESMF_LogWrite(trim(subname)//' open file '//trim(filename), ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//' ERROR: file invalid '//trim(filename), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) + rc = ESMF_FAILURE + return + endif + + do k = 1,nf + call shr_nuopc_methods_FB_getNameN(FB, k, itemc, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_getFldPtr(FB, itemc, fldptr1=fldptr1, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + name1 = trim(lpre)//'_'//trim(itemc) + call ESMF_LogWrite(trim(subname)//' read field '//trim(name1), ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call pio_seterrorhandling(pioid, PIO_BCAST_ERROR) + rcode = pio_inq_varid(pioid,trim(name1),varid) + if (rcode == pio_noerr) then + + if (k == 1) then + rcode = pio_inq_varndims(pioid, varid, ndims) + write(tmpstr,*) trim(subname),' ndims = ',ndims,k + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + allocate(dimid(ndims)) + rcode = pio_inq_vardimid(pioid, varid, dimid(1:ndims)) + rcode = pio_inq_dimlen(pioid, dimid(1), lnx) + write(tmpstr,*) trim(subname),' lnx = ',lnx + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (ndims>=2) then + rcode = pio_inq_dimlen(pioid, dimid(2), lny) + else + lny = 1 + end if + deallocate(dimid) + write(tmpstr,*) trim(subname),' lny = ',lny + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + ng = lnx * lny + + call shr_nuopc_methods_FB_getFieldN(FB, k, field, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, mesh=mesh, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + allocate(minIndexPTile(dimCount, tileCount), & + maxIndexPTile(dimCount, tileCount)) + call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & + maxIndexPTile=maxIndexPTile, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + !write(tmpstr,*) subname,' counts = ',dimcount,tilecount,minindexptile,maxindexptile + !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + if (ng > maxval(maxIndexPTile)) then + write(tmpstr,*) subname,' ERROR: dimensions do not match', lnx, lny, maxval(maxIndexPTile) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) + + !TODO: this should not be an error for say CTSM which does not send a global grid + !rc = ESMF_Failure + !return + endif + + call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + allocate(dof(ns)) + call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) + write(tmpstr,*) subname,' dof = ',ns,size(dof),dof(1),dof(ns) !,minval(dof),maxval(dof) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) + deallocate(dof) + endif + call pio_setframe(pioid,varid,lframe) + call pio_read_darray(pioid, varid, iodesc, fldptr1, rcode) + rcode = pio_get_att(pioid,varid,"_FillValue",lfillvalue) + if (rcode /= pio_noerr) then + lfillvalue = fillvalue + endif + do n = 1,size(fldptr1) + if (fldptr1(n) == lfillvalue) fldptr1(n) = 0.0_r8 + enddo + else + fldptr1 = 0.0_r8 + endif + call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) + enddo + + deallocate(minIndexPTile, maxIndexPTile) + call pio_freedecomp(pioid, iodesc) + call pio_closefile(pioid) + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + endif + + end subroutine med_io_read_FB + + !=============================================================================== + subroutine med_io_read_int(filename, vm, iam, idata, dname) + + ! !DESCRIPTION: Read scalar integer from netcdf file + + ! input/output arguments + character(len=*) , intent(in) :: filename ! file + type(ESMF_VM) :: vm + integer , intent(in) :: iam + integer , intent(inout) :: idata ! integer data + character(len=*) , intent(in) :: dname ! name of data + + ! local variables + integer :: i1d(1) + character(*),parameter :: subName = '(med_io_read_int) ' + !------------------------------------------------------------------------------- + + call med_io_read_int1d(filename, vm, iam, i1d, dname) + idata = i1d(1) + + end subroutine med_io_read_int + + !=============================================================================== + subroutine med_io_read_int1d(filename, vm, iam, idata, dname) + + ! !DESCRIPTION: Read 1d integer array from netcdf file + + use shr_sys_mod , only : shr_sys_abort + use med_constants_mod , only : R8 + use pio , only : var_desc_t, file_desc_t, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR, pio_seterrorhandling + use pio , only : pio_get_var, pio_inq_varid, pio_get_att, pio_openfile + use pio , only : pio_nowrite, pio_openfile, pio_global + use pio , only : pio_closefile + use med_internalstate_mod , only : logunit + + ! input/output arguments + character(len=*), intent(in) :: filename ! file + type(ESMF_VM) :: vm + integer, intent(in) :: iam + integer , intent(inout) :: idata(:) ! integer data + character(len=*), intent(in) :: dname ! name of data + + ! local variables + integer :: rcode + type(file_desc_t) :: pioid + type(var_desc_t) :: varid + logical :: exists + character(CL) :: lversion + character(CL) :: name1 + integer :: rc + character(*),parameter :: subName = '(med_io_read_int1d) ' + !------------------------------------------------------------------------------- + + lversion=trim(version) + + if (med_io_file_exists(vm, iam, filename)) then + rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) + call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) + rcode = pio_get_att(pioid,pio_global,"file_version",lversion) + call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) + else + if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname) + call shr_sys_abort(trim(subname)//'ERROR: file invalid '//trim(filename)//' '//trim(dname)) + endif + + if (trim(lversion) == trim(version)) then + name1 = trim(dname) + else + name1 = trim(prefix)//trim(dname) + endif + rcode = pio_inq_varid(pioid,trim(name1),varid) + rcode = pio_get_var(pioid,varid,idata) + + call pio_closefile(pioid) + end subroutine med_io_read_int1d + + !=============================================================================== + subroutine med_io_read_r8(filename, vm, iam, rdata, dname) + use med_constants_mod, only : R8 + + ! !DESCRIPTION: Read scalar double from netcdf file + + ! input/output arguments + character(len=*) , intent(in) :: filename ! file + type(ESMF_VM) :: vm + integer , intent(in) :: iam + real(r8) , intent(inout) :: rdata ! real data + character(len=*) , intent(in) :: dname ! name of data + + ! local variables + real(r8) :: r1d(1) + character(*),parameter :: subName = '(med_io_read_r8) ' + !------------------------------------------------------------------------------- + + call med_io_read_r81d(filename, vm, iam, r1d,dname) + rdata = r1d(1) + end subroutine med_io_read_r8 + + !=============================================================================== + subroutine med_io_read_r81d(filename, vm, iam, rdata, dname) + use med_constants_mod, only : R8 + use pio, only : file_desc_t, var_desc_t, pio_openfile, pio_closefile, pio_seterrorhandling + use pio, only : PIO_BCAST_ERROR, PIO_INTERNAL_ERROR, pio_inq_varid, pio_get_var + use pio, only : pio_nowrite, pio_openfile, pio_global, pio_get_att + use med_internalstate_mod, only : logunit + use shr_sys_mod, only : shr_sys_abort + ! !DESCRIPTION: Read 1d double array from netcdf file + + ! input/output arguments + character(len=*), intent(in) :: filename ! file + type(ESMF_VM) :: vm + integer , intent(in) :: iam + real(r8) , intent(inout) :: rdata(:) ! real data + character(len=*), intent(in) :: dname ! name of data + + ! local variables + integer :: rcode + type(file_desc_T) :: pioid + type(var_desc_t) :: varid + logical :: exists + + integer :: rc + character(CL) :: lversion + character(CL) :: name1 + character(*),parameter :: subName = '(med_io_read_r81d) ' + !------------------------------------------------------------------------------- + + lversion=trim(version) + + if (med_io_file_exists(vm, iam, filename)) then + rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) + call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) + rcode = pio_get_att(pioid,pio_global,"file_version",lversion) + call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) + else + if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname) + call shr_sys_abort(trim(subname)//'ERROR: file invalid '//trim(filename)//' '//trim(dname)) + endif + + if (trim(lversion) == trim(version)) then + name1 = trim(dname) + else + name1 = trim(prefix)//trim(dname) + endif + rcode = pio_inq_varid(pioid,trim(name1),varid) + rcode = pio_get_var(pioid,varid,rdata) + + call pio_closefile(pioid) + end subroutine med_io_read_r81d + + !=============================================================================== + subroutine med_io_read_char(filename, vm, iam, rdata, dname) + use pio, only : file_desc_t, var_desc_t, pio_seterrorhandling, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR + use pio, only : pio_closefile, pio_inq_varid, pio_get_var + use pio, only : pio_openfile, pio_global, pio_get_att, pio_nowrite + use med_internalstate_mod, only : logunit + use shr_sys_mod, only : shr_sys_abort + ! !DESCRIPTION: Read char string from netcdf file + + ! input/output arguments + character(len=*), intent(in) :: filename ! file + type(ESMF_VM) :: vm + integer, intent(in) :: iam + character(len=*), intent(inout) :: rdata ! character data + character(len=*), intent(in) :: dname ! name of data + + ! local variables + integer :: rcode + type(file_desc_T) :: pioid + type(var_desc_t) :: varid + logical :: exists + integer :: rc + character(CL) :: lversion + character(CL) :: name1 + character(CL) :: charvar ! buffer for string read/write + character(*),parameter :: subName = '(med_io_read_char) ' + !------------------------------------------------------------------------------- + + lversion=trim(version) + + if (med_io_file_exists(vm, iam, filename)) then + rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) + ! write(logunit,*) subname,' open file ',trim(filename) + call pio_seterrorhandling(pioid,PIO_BCAST_ERROR) + rcode = pio_get_att(pioid,pio_global,"file_version",lversion) + call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) + else + if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname) + call shr_sys_abort(trim(subname)//'ERROR: file invalid '//trim(filename)//' '//trim(dname)) + endif + + if (trim(lversion) == trim(version)) then + name1 = trim(dname) + else + name1 = trim(prefix)//trim(dname) + endif + rcode = pio_inq_varid(pioid,trim(name1),varid) + rcode = pio_get_var(pioid,varid,charvar) + rdata = trim(charvar) + + call pio_closefile(pioid) + end subroutine med_io_read_char + +end module med_io_mod diff --git a/src/mediator/med_map_mod.F90 b/src/mediator/med_map_mod.F90 new file mode 100644 index 00000000..454e1e0d --- /dev/null +++ b/src/mediator/med_map_mod.F90 @@ -0,0 +1,1098 @@ +module med_map_mod + + use med_constants_mod , only : CX, CS, CL, R8 + use med_constants_mod , only : ispval_mask => med_constants_ispval_mask + use med_constants_mod , only : czero => med_constants_czero + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + + implicit none + private + + ! public routines + public :: med_map_RouteHandles_init + public :: med_map_Fractions_init + public :: med_map_MapNorm_init + public :: med_map_FB_Regrid_Norm + + interface med_map_FB_Regrid_norm + module procedure med_map_FB_Regrid_Norm_All + module procedure med_map_FB_Regrid_Norm_Frac + end interface + + ! private module variables + + character(*) , parameter :: u_FILE_u = __FILE__ + ! should this be a module variable? + integer :: srcTermProcessing_Value = 0 + logical :: mastertask + +!================================================================================ +contains +!================================================================================ + + subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) + + !--------------------------------------------- + ! Initialize route handles in the mediator + ! Assumptions: + ! - Route handles are created per target field bundles NOT + ! per individual fields in the bundle + ! - ALL fields in the bundle are on identical grids + ! - MULTIPLE route handles are going to be generated for + ! given field bundle source and destination grids + ! - Route handles will ONLY be created if coupling is active + ! between n1 and n2 + ! Algorithm + ! n1=source component index + ! n2=destination component index + ! nf=field index + ! fldListFr(n)%flds(nf) is queried to determine the mapindex and mapfile + ! and the appropriate route handle is created + ! + ! Regridding is done on a per-field basis AND only for those fields that have a + ! valid mapping index for the destination component + ! n = source field index field index + ! destcomp = destination component index + ! The fldsSrc input argument is queried for the mapping type of the field + ! for the desination component + ! mapindex = fldsSrc(n)%mapindex(destcomp) + ! If the mapindex is 0 (there is no valid mapping) then NO mapping is done + ! for the field + !--------------------------------------------- + + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LogFlush, ESMF_KIND_I4 + use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_Field, ESMF_PoleMethod_Flag, ESMF_POLEMETHOD_ALLAVG + use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_FieldSMMStore, ESMF_RouteHandleIsCreated + use ESMF , only : ESMF_FieldRedistStore, ESMF_FieldRegridStore, ESMF_REGRIDMETHOD_BILINEAR + use ESMF , only : ESMF_UNMAPPEDACTION_IGNORE, ESMF_REGRIDMETHOD_CONSERVE, ESMF_NORMTYPE_FRACAREA + use ESMF , only : ESMF_REGRIDMETHOD_NEAREST_STOD + use ESMF , only : ESMF_NORMTYPE_DSTAREA, ESMF_REGRIDMETHOD_PATCH, ESMF_RouteHandlePrint + use NUOPC , only : NUOPC_Write + use esmFlds , only : ncomps, compice, compocn, compname + use esmFlds , only : fldListFr, fldListTo + use esmFlds , only : mapnames + use esmFlds , only : mapbilnr, mapconsf, mapconsd, mappatch, mapfcopy + use esmFlds , only : mapunset, mapfiler, mapnstod, mapnstod_consd, mapnstod_consf + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFieldN + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use med_internalstate_mod , only : InternalState + use perf_mod , only : t_startf, t_stopf + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(in) :: llogunit + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + type(ESMF_VM) :: vm + type(ESMF_Field) :: fldsrc + type(ESMF_Field) :: flddst + integer :: localPet + integer :: n,n1,n2,m,nf,nflds,ncomp + integer :: SrcMaskValue + integer :: DstMaskValue + character(len=128) :: value + character(len=128) :: rhname + character(len=128) :: rhname_file + character(len=CS) :: mapname + character(len=CX) :: mapfile + character(len=CS) :: string + integer :: mapindex + logical :: rhprint_flag = .false. + logical :: mapexists = .false. + real(R8) , pointer :: factorList(:) + character(CL) , pointer :: fldnames(:) + !integer(ESMF_KIND_I4), pointer :: unmappedDstList(:) + character(len=128) :: logMsg + integer :: dbrc + type(ESMF_PoleMethod_Flag), parameter :: polemethod=ESMF_POLEMETHOD_ALLAVG + character(len=*), parameter :: subname=' (module_med_map: RouteHandles_init) ' + !----------------------------------------------------------- + call t_startf('MED:'//subname) + + if (dbug_flag > 1) then + call ESMF_LogWrite("Starting to initialize RHs", ESMF_LOGMSG_INFO) + call ESMF_LogFlush() + endif + + rc = ESMF_SUCCESS + + ! Determine mastertask + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + call ESMF_VMGet(vm, localPet=localPet, rc=rc) + mastertask = .false. + if (localPet == 0) mastertask=.true. + ! Get the internal state from Component. + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create the necessary route handles + if (mastertask) write(llogunit,*) ' ' + do n1 = 1, ncomps + do n2 = 1, ncomps + + dstMaskValue = ispval_mask + srcMaskValue = ispval_mask + if (n1 == compocn .or. n1 == compice) srcMaskValue = 0 + if (n2 == compocn .or. n2 == compice) dstMaskValue = 0 + + !--- get single fields from bundles + !--- 1) ASSUMES all fields in the bundle are on identical grids + !--- 2) MULTIPLE route handles are going to be generated for + !--- given field bundle source and destination grids + + if (n1 /= n2) then + + ! Determine route handle names + rhname = trim(compname(n1))//"2"//trim(compname(n2)) + + if (is_local%wrap%med_coupling_active(n1,n2)) then ! If coupling is active between n1 and n2 + + call shr_nuopc_methods_FB_getFieldN(is_local%wrap%FBImp(n1,n1), 1, fldsrc, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_getFieldN(is_local%wrap%FBImp(n1,n2), 1, flddst, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Loop over fields + do nf = 1,size(fldListFr(n1)%flds) + + ! Determine the mapping type for mapping field nf from n1 to n2 + mapindex = fldListFr(n1)%flds(nf)%mapindex(n2) + + ! separate check first since Fortran does not have short-circuit evaluation + if (mapindex == mapunset) cycle + + ! Create route handle for target mapindex if route handle is required + ! (i.e. mapindex /= mapunset) and route handle has not already been created + mapexists = .false. + if (mapindex == mapnstod_consd .and. & + ESMF_RouteHandleIsCreated(is_local%wrap%RH(n1,n2,mapnstod), rc=rc) .and. & + ESMF_RouteHandleIsCreated(is_local%wrap%RH(n1,n2,mapconsd), rc=rc)) then + mapexists = .true. + else if (mapindex == mapnstod_consf .and. & + ESMF_RouteHandleIsCreated(is_local%wrap%RH(n1,n2,mapnstod), rc=rc) .and. & + ESMF_RouteHandleIsCreated(is_local%wrap%RH(n1,n2,mapconsf), rc=rc)) then + mapexists = .true. + else if (ESMF_RouteHandleIsCreated(is_local%wrap%RH(n1,n2,mapindex), rc=rc)) then + mapexists = .true. + end if + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (.not. mapexists) then + + mapname = trim(mapnames(mapindex)) + mapfile = trim(fldListFr(n1)%flds(nf)%mapfile(n2)) + string = trim(rhname)//'_weights' + + if (mapindex == mapfiler .and. mapfile /= 'unset') then + ! TODO: actually error out if mapfile is unset in this case + if (mastertask) then + write(llogunit,'(4A)') subname,trim(string),' RH '//trim(mapname)//' via input file ',& + trim(mapfile) + end if + call ESMF_LogWrite(subname // trim(string) //& + ' RH '//trim(mapname)//' via input file '//trim(mapfile), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_FieldSMMStore(fldsrc, flddst, mapfile, & + routehandle=is_local%wrap%RH(n1,n2,mapindex), & + ignoreUnmatchedIndices=.true., & + srcTermProcessing=srcTermProcessing_Value, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else if (mapindex == mapfcopy) then + if (mastertask) then + write(llogunit,'(3A)') subname,trim(string),' RH redist ' + end if + call ESMF_LogWrite(trim(subname) // trim(string) // ' RH redist ', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_FieldRedistStore(fldsrc, flddst, & + routehandle=is_local%wrap%RH(n1,n2,mapindex), & + ignoreUnmatchedIndices = .true., rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else if (mapfile /= 'unset') then + if (mastertask) then + write(llogunit,'(4A)') subname,trim(string),' RH '//trim(mapname)//' via input file ',& + trim(mapfile) + end if + call ESMF_LogWrite(subname // trim(string) //& + ' RH '//trim(mapname)//' via input file '//trim(mapfile), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_FieldSMMStore(fldsrc, flddst, mapfile, & + routehandle=is_local%wrap%RH(n1,n2,mapindex), & + ignoreUnmatchedIndices=.true., & + srcTermProcessing=srcTermProcessing_Value, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else + if (mastertask) write(llogunit,'(3A)') subname,trim(string),& + ' RH regrid for '//trim(mapname)//' computed on the fly' + call ESMF_LogWrite(subname // trim(string) //& + ' RH regrid for '//trim(mapname)//' computed on the fly', ESMF_LOGMSG_INFO, rc=dbrc) + if (mapindex == mapbilnr) then + srcTermProcessing_Value = 0 + call ESMF_FieldRegridStore(fldsrc, flddst, & + routehandle=is_local%wrap%RH(n1,n2,mapindex), & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & + polemethod=polemethod, & + srcTermProcessing=srcTermProcessing_Value, & + factorList=factorList, & + ignoreDegenerate=.true., & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) + else if ((mapindex == mapconsf .or. mapindex == mapnstod_consf) .and. & + .not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(n1,n2,mapconsf))) then + call ESMF_FieldRegridStore(fldsrc, flddst, & + routehandle=is_local%wrap%RH(n1,n2,mapconsf), & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & + normType=ESMF_NORMTYPE_FRACAREA, & + srcTermProcessing=srcTermProcessing_Value, & + factorList=factorList, & + ignoreDegenerate=.true., & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + !unmappedDstList=unmappedDstList, & + rc=rc) + else if ((mapindex == mapconsd .or. mapindex == mapnstod_consd) .and. & + .not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(n1,n2,mapconsd))) then + call ESMF_FieldRegridStore(fldsrc, flddst, & + routehandle=is_local%wrap%RH(n1,n2,mapconsd), & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & + normType=ESMF_NORMTYPE_DSTAREA, & + srcTermProcessing=srcTermProcessing_Value, & + factorList=factorList, & + ignoreDegenerate=.true., & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + !unmappedDstList=unmappedDstList, & + rc=rc) + else if (mapindex == mappatch) then + call ESMF_FieldRegridStore(fldsrc, flddst, & + routehandle=is_local%wrap%RH(n1,n2,mapindex), & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_PATCH, & + polemethod=polemethod, & + srcTermProcessing=srcTermProcessing_Value, & + factorList=factorList, & + ignoreDegenerate=.true., & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) + end if + ! consd_nstod method requires a second routehandle + if ((mapindex == mapnstod .or. mapindex == mapnstod_consd .or. mapindex == mapnstod_consf) .and. & + .not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(n1,n2,mapnstod),rc=rc)) then + call ESMF_FieldRegridStore(fldsrc, flddst, & + routehandle=is_local%wrap%RH(n1,n2,mapnstod), & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_NEAREST_STOD, & + srcTermProcessing=srcTermProcessing_Value, & + factorList=factorList, & + ignoreDegenerate=.true., & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + rc=rc) + end if + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (rhprint_flag .and. mapindex /= mapnstod_consd .and. mapindex /= mapnstod_consf) then + call NUOPC_Write(factorList, "array_med_"//trim(string)//"_consf.nc", rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + !if (associated(unmappedDstList)) then + ! write(logMsg,*) trim(subname),trim(string),' number of unmapped dest points = ', size(unmappedDstList) + ! call ESMF_LogWrite(trim(logMsg), ESMF_LOGMSG_INFO, rc=dbrc) + !end if + end if + if (rhprint_flag .and. mapindex /= mapnstod_consd .and. mapindex /= mapnstod_consf) then + call ESMF_LogWrite(trim(subname)//trim(string)//": printing RH for "//trim(mapname), & + ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_RouteHandlePrint(is_local%wrap%RH(n1,n2,mapindex), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check that a valid route handle has been created + if ( mapindex /= mapnstod_consd .and. mapindex /= mapnstod_consf .and. & + .not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(n1,n2,mapindex), rc=rc)) then + call ESMF_LogWrite(trim(subname)//trim(string)//": failed RH "//trim(mapname), & + ESMF_LOGMSG_INFO, rc=dbrc) + endif + end if + end do ! loop over fields + end if ! if coupling is active between n1 and n2 + end if ! if n1 not equal to n2 + end do ! loop over n2 + end do ! loop over n1 + + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + call t_stopf('MED:'//subname) + + end subroutine med_map_RouteHandles_init + + !================================================================================ + + subroutine med_map_Fractions_init(gcomp, n1, n2, FBSrc, FBDst, RouteHandle, rc) + + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LogFlush + use ESMF , only : ESMF_GridComp, ESMF_FieldBundle, ESMF_RouteHandle, ESMF_Field + use ESMF , only : ESMF_FieldRedistStore, ESMF_FieldSMMStore, ESMF_FieldRegridStore + use ESMF , only : ESMF_UNMAPPEDACTION_IGNORE, ESMF_REGRIDMETHOD_CONSERVE, ESMF_NORMTYPE_FRACAREA + use NUOPC , only : NUOPC_CompAttributeGet + use esmFlds , only : ncomps, compice, compocn, compname + use esmflds , only : mapnames, mapconsf + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFieldN + use perf_mod , only : t_startf, t_stopf + !--------------------------------------------- + ! Initialize initialize additional route handles + ! for mapping fractions + !--------------------------------------------- + + type(ESMF_GridComp) :: gcomp + integer , intent(in) :: n1 + integer , intent(in) :: n2 + type(ESMF_FieldBundle) , intent(in) :: FBSrc + type(ESMF_FieldBundle) , intent(in) :: FBDst + type(ESMF_RouteHandle) , intent(inout) :: RouteHandle + integer , intent(out) :: rc + + ! local variables + type(ESMF_Field) :: fldsrc + type(ESMF_Field) :: flddst + character(len=128) :: rhname + character(len=CS) :: mapname + character(len=CX) :: mapfile + character(len=CS) :: string + integer :: SrcMaskValue + integer :: DstMaskValue + real(R8), pointer :: factorList(:) + integer :: dbrc + character(len=*), parameter :: subname=' (med_map_fractions_init: ) ' + !--------------------------------------------- + call t_startf('MED:'//subname) + + if (dbug_flag > 1) then + call ESMF_LogWrite("Initializing RHs not yet created and needed for mapping fractions", & + ESMF_LOGMSG_INFO) + call ESMF_LogFlush() + endif + + rc = ESMF_SUCCESS + + call shr_nuopc_methods_FB_getFieldN(FBsrc, 1, fldsrc, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_getFieldN(FBDst, 1, flddst, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + dstMaskValue = ispval_mask + srcMaskValue = ispval_mask + if (n1 == compocn .or. n1 == compice) srcMaskValue = 0 + if (n2 == compocn .or. n2 == compice) dstMaskValue = 0 + + rhname = trim(compname(n1))//"2"//trim(compname(n2)) + string = trim(rhname)//'_weights' + if ( (n1 == compocn .and. n2 == compice) .or. (n1 == compice .and. n2 == compocn)) then + mapfile = 'idmap' + else + call ESMF_LogWrite("Querying for attribute "//trim(rhname)//"_fmapname = ", ESMF_LOGMSG_INFO) + call NUOPC_CompAttributeGet(gcomp, name=trim(rhname)//"_fmapname", value=mapfile, rc=rc) + mapname = trim(mapnames(mapconsf)) + end if + + if (mapfile == 'idmap') then + call ESMF_LogWrite(trim(subname) // trim(string) //& + ' RH '//trim(mapname)// ' is redist', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_FieldRedistStore(fldsrc, flddst, & + routehandle=RouteHandle, & + ignoreUnmatchedIndices = .true., rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else if (mapfile /= 'unset') then + call ESMF_LogWrite(subname // trim(string) //& + ' RH '//trim(mapname)//' via input file '//trim(mapfile), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_FieldSMMStore(fldsrc, flddst, mapfile, & + routehandle=RouteHandle, & + ignoreUnmatchedIndices=.true., & + srcTermProcessing=srcTermProcessing_Value, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(subname // trim(string) //& + ' RH '//trim(mapname)//' computed on the fly '//trim(mapfile), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_FieldRegridStore(fldsrc, flddst, & + routehandle=RouteHandle, & + srcMaskValues=(/srcMaskValue/), & + dstMaskValues=(/dstMaskValue/), & + regridmethod=ESMF_REGRIDMETHOD_CONSERVE, & + normType=ESMF_NORMTYPE_FRACAREA, & + srcTermProcessing=srcTermProcessing_Value, & + factorList=factorList, & + ignoreDegenerate=.true., & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) + end if + + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + call t_stopf('MED:'//subname) + + end subroutine med_map_Fractions_init + +!================================================================================ + + subroutine med_map_MapNorm_init(gcomp, llogunit, rc) + + !--------------------------------------- + ! Initialize unity normalization field bundle + ! and do the mapping for unity normalization up front + !--------------------------------------- + + use ESMF , only: ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LogFlush + use ESMF , only: ESMF_GridComp, ESMF_FieldBundle, ESMF_RouteHandleIsCreated + use esmFlds , only: ncomps, compice, compocn, compname + use esmFlds , only: mapnames, nmappers + use med_internalstate_mod , only: InternalState + use shr_nuopc_scalars_mod , only: flds_scalar_name, flds_scalar_num + use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_Init + use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_Reset + use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_Clean + use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_GetFldPtr + use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_FieldRegrid + use shr_nuopc_methods_mod , only: shr_nuopc_methods_ChkErr + use perf_mod , only: t_startf, t_stopf + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(in) :: llogunit + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + type(ESMF_FieldBundle) :: FBTmp + integer :: n1, n2, m + character(len=CS) :: normname + character(len=1) :: cn1,cn2,cm + real(R8), pointer :: dataptr(:) + integer :: dbrc + character(len=*),parameter :: subname='(module_MED_MAP:MapNorm_init)' + !----------------------------------------------------------- + call t_startf('MED:'//subname) + + if (dbug_flag > 1) then + call ESMF_LogWrite("Starting to initialize unity map normalizations", ESMF_LOGMSG_INFO) + call ESMF_LogFlush() + endif + + rc = ESMF_SUCCESS + + ! Get the internal state from Component. + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create the normalization field bundles + normname = 'one' + do n1 = 1,ncomps + do n2 = 1,ncomps + if (n1 /= n2) then + if (is_local%wrap%med_coupling_active(n1,n2)) then + do m = 1,nmappers + if (ESMF_RouteHandleIsCreated(is_local%wrap%RH(n1,n2,m), rc=rc)) then + if (dbug_flag > 1) then + write(cn1,'(i1)') n1; write(cn2,'(i1)') n2; write(cm ,'(i1)') m + call ESMF_LogWrite(trim(subname)//":"//'creating FBMapNormOne for '& + //compname(n1)//'->'//compname(n2)//'with mapping '//mapnames(m), & + ESMF_LOGMSG_INFO, rc=dbrc) + endif + call shr_nuopc_methods_FB_init(FBout=is_local%wrap%FBNormOne(n1,n2,m), & + flds_scalar_name=flds_scalar_name, & + FBgeom=is_local%wrap%FBImp(n1,n2), & + fieldNameList=(/trim(normname)/), name='FBNormOne', rc=rc) + if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + + call shr_nuopc_methods_FB_reset(is_local%wrap%FBNormOne(n1,n2,m), value=czero, rc=rc) + if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + + call shr_nuopc_methods_FB_init(FBout=FBTmp, & + flds_scalar_name=flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(n1), & + fieldNameList=(/trim(normname)/), name='FBTmp', rc=rc) + if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + + call shr_nuopc_methods_FB_GetFldPtr(FBTmp, trim(normname), fldptr1=dataPtr, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + dataptr(:) = 1.0_R8 + + call shr_nuopc_methods_FB_FieldRegrid(& + FBTmp , normname, & + is_local%wrap%FBNormOne(n1,n2,m), normname, & + is_local%wrap%RH(n1,n2,m), rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_clean(FBTmp, rc=rc) + if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + end if + end do + end if + end if + end do + end do + + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + call t_stopf('MED:'//subname) + + end subroutine med_map_MapNorm_init + + !================================================================================ + + subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & + FBSrc, FBDst, FBFrac, FBNormOne, RouteHandles, string, rc) + + ! ---------------------------------------------- + ! Map field bundles with appropriate fraction weighting + ! ---------------------------------------------- + + use NUOPC , only: NUOPC_IsConnected + use ESMF , only: ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only: ESMF_LOGMSG_ERROR, ESMF_FAILURE + use ESMF , only: ESMF_FieldBundle, ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet + use ESMF , only: ESMF_RouteHandle, ESMF_RouteHandleIsCreated, ESMF_Field + use ESMF , only: ESMF_REGION_SELECT, ESMF_REGION_TOTAL + use esmFlds , only: compname + use esmFlds , only: mapnames, mapfcopy, mapconsd, mapconsf, mapnstod + use esmFlds , only: mapnstod_consd, mapnstod_consf + use esmFlds , only: shr_nuopc_fldList_entry_type + use shr_nuopc_scalars_mod , only: flds_scalar_name + use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_Init + use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_Reset + use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_Clean + use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_GetFldPtr + use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_FieldRegrid + use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_FldChk + use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_Field_diagnose + use shr_nuopc_methods_mod , only: shr_nuopc_methods_ChkErr + use shr_nuopc_utils_mod , only: shr_nuopc_memcheck + use perf_mod , only: t_startf, t_stopf + + ! input/output variables + type(shr_nuopc_fldList_entry_type) , pointer :: fldsSrc(:) + integer , intent(in) :: srccomp + integer , intent(in) :: destcomp + type(ESMF_FieldBundle) , intent(inout) :: FBSrc + type(ESMF_FieldBundle) , intent(inout) :: FBDst + type(ESMF_FieldBundle) , intent(in) :: FBFrac + type(ESMF_FieldBundle) , intent(in) :: FBNormOne(:) + type(ESMF_RouteHandle) , intent(inout) :: RouteHandles(:) + character(len=*), optional , intent(in) :: string + integer , intent(out) :: rc + + ! local variables + integer :: i, n + type(ESMF_Field) :: srcField + type(ESMF_Field) :: tmpfield + integer :: mapindex + character(len=CS) :: lstring + character(len=CS) :: mapnorm + character(len=CS) :: fldname + real(R8), allocatable :: data_srctmp(:) ! temporary + real(R8), allocatable :: data_dsttmp(:) ! temporary + real(R8), pointer :: data_src(:) + real(R8), pointer :: data_dst(:) + real(R8), pointer :: data_frac(:) + real(R8), pointer :: data_norm(:) + integer :: dbrc + character(len=*), parameter :: subname='(module_MED_Map:med_map_Regrid_Norm)' + !------------------------------------------------------------------------------- + + call t_startf('MED:'//subname) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call shr_nuopc_memcheck(subname, 1, mastertask) + + !--------------------------------------- + + if (present(string)) then + lstring = trim(string) + else + lstring = " " + endif + + rc = ESMF_SUCCESS + + !--------------------------------------- + ! First - reset the field bundle on the destination grid to zero + !--------------------------------------- + + call shr_nuopc_methods_FB_reset(FBDst, value=czero, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + ! Loop over all fields in the source field bundle and map them to + ! the destination field bundle accordingly + !--------------------------------------- + + call ESMF_LogWrite(trim(subname)//" *** mapping from "//trim(compname(srccomp))//" to "//& + trim(compname(destcomp))//" ***", ESMF_LOGMSG_INFO, rc=dbrc) + + do n = 1,size(fldsSrc) + ! Determine if field is a scalar - and if so go to next iternation + fldname = fldsSrc(n)%shortname + if (fldname == flds_scalar_name) CYCLE + + ! Determine if there is a map index and if its zero go to next iteration + mapindex = fldsSrc(n)%mapindex(destcomp) + if (mapindex == 0) CYCLE + mapnorm = fldsSrc(n)%mapnorm(destcomp) + + ! Error checks + if (.not. shr_nuopc_methods_FB_FldChk(FBSrc, fldname, rc=rc)) then + call ESMF_LogWrite(trim(subname)//" field not found in FBSrc: "//trim(fldname), ESMF_LOGMSG_INFO, rc=dbrc) + else if (.not. shr_nuopc_methods_FB_FldChk(FBDst, fldname, rc=rc)) then + call ESMF_LogWrite(trim(subname)//" field not found in FBDst: "//trim(fldname), ESMF_LOGMSG_INFO, rc=dbrc) + else if (mapindex == mapnstod_consd) then + if (.not. ESMF_RouteHandleIsCreated(RouteHandles(mapconsd), rc=rc) .or. & + .not. ESMF_RouteHandleIsCreated(RouteHandles(mapnstod), rc=rc)) then + call ESMF_LogWrite(trim(subname)//trim(lstring)//& + ": ERROR RH not available for "//mapnames(mapindex)//": fld="//trim(fldname), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + end if + else if (mapindex == mapnstod_consf) then + if (.not. ESMF_RouteHandleIsCreated(RouteHandles(mapconsf), rc=rc) .or. & + .not. ESMF_RouteHandleIsCreated(RouteHandles(mapnstod), rc=rc)) then + call ESMF_LogWrite(trim(subname)//trim(lstring)//& + ": ERROR RH not available for "//mapnames(mapindex)//": fld="//trim(fldname), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + end if + else if (.not. ESMF_RouteHandleIsCreated(RouteHandles(mapindex), rc=rc)) then + call ESMF_LogWrite(trim(subname)//trim(lstring)//& + ": ERROR RH not available for "//mapnames(mapindex)//": fld="//trim(fldname), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + end if + + ! Determine if field is FBSrc or FBDst or connected - and if not go to next iteration + if (.not. shr_nuopc_methods_FB_FldChk(FBSrc, trim(fldname), rc=rc)) then + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//" field not found in FBSrc: "//trim(fldname), ESMF_LOGMSG_INFO, rc=dbrc) + end if + CYCLE + else if (.not. shr_nuopc_methods_FB_FldChk(FBDst, trim(fldname), rc=rc)) then + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//" field not found in FBDst: "//trim(fldname), ESMF_LOGMSG_INFO, rc=dbrc) + end if + CYCLE + end if + + call ESMF_LogWrite(trim(subname)//" --> remapping "//trim(fldname)//" with "//trim(mapnames(mapindex)), & + ESMF_LOGMSG_INFO) + + ! Do the mapping + if (mapindex == mapfcopy) then + call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapindex), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + else + ! Determine the normalization for the map + mapnorm = fldsSrc(n)%mapnorm(destcomp) + + if ( trim(mapnorm) /= 'unset' .and. trim(mapnorm) /= 'one' .and. trim(mapnorm) /= 'none') then + + ! Get field and pointer to source field data in FBSrc + call shr_nuopc_methods_FB_GetFldPtr(FBSrc, fldname, data_src, field=srcfield, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (.not. allocated(data_srctmp) .or. size(data_srctmp) /= size(data_src)) then + if (allocated(data_srctmp)) then + deallocate(data_srctmp) + endif + allocate(data_srctmp(size(data_src))) + endif + + !------------------------------------------------- + ! fractional normalization + !------------------------------------------------- + + ! get a pointer to the array of the normalization on the source grid - this must + ! be the same size is as fraction on the source grid + call shr_nuopc_methods_FB_GetFldPtr(FBFrac, trim(mapnorm), data_frac, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! regrid FBSrc to FBDst + ! Copy data_src to data_srctmp and multiply by fraction, regrid this then replace with original data_src + data_srctmp = data_src + data_src = data_src * data_frac + + if (mapindex == mapnstod_consd) then + call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapnstod), rc, & + zeroregion=ESMF_REGION_TOTAL) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! temp diagnostics + call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after nstod: ", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapconsd), rc, & + zeroregion=ESMF_REGION_SELECT) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! temp diagnostics + call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after consd: ", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + else if (mapindex == mapnstod_consf) then + call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapnstod), rc, & + zeroregion=ESMF_REGION_TOTAL) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! temp diagnostics + call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after nstod: ", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapconsf), rc, & + zeroregion=ESMF_REGION_SELECT) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! temp diagnostics + call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after consf: ", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else + + call shr_nuopc_methods_FB_FieldRegrid( FBSrc, trim(fldname), FBDst, fldname, RouteHandles(mapindex), rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end if + + ! Restore original value + data_src = data_srctmp + + call shr_nuopc_methods_FB_GetFldPtr(FBDst, trim(fldname), data_dst, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (.not. allocated(data_dsttmp) .or. size(data_dsttmp) /= size(data_dst)) then + if(allocated(data_dsttmp)) then + deallocate(data_dsttmp) + endif + allocate(data_dsttmp(size(data_dst))) + endif + + ! Copy data_dst to tmp location, regrid fraction from source + data_dsttmp = data_dst + data_dst = czero + + if (mapindex == mapnstod_consd) then + call shr_nuopc_methods_FB_FieldRegrid(FBFrac, mapnorm, FBDst, trim(fldname), RouteHandles(mapnstod), rc, & + zeroregion=ESMF_REGION_TOTAL) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_FieldRegrid(FBFrac, mapnorm, FBDst, trim(fldname), RouteHandles(mapconsd), rc, & + zeroregion=ESMF_REGION_SELECT) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else if (mapindex == mapnstod_consf) then + call shr_nuopc_methods_FB_FieldRegrid(FBFrac, mapnorm, FBDst, trim(fldname), RouteHandles(mapnstod), rc, & + zeroregion=ESMF_REGION_TOTAL) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_FieldRegrid(FBFrac, mapnorm, FBDst, trim(fldname), RouteHandles(mapconsf), rc, & + zeroregion=ESMF_REGION_SELECT) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_nuopc_methods_FB_FieldRegrid(FBFrac, mapnorm, FBDst, trim(fldname), RouteHandles(mapindex), rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + do i= 1,size(data_dst) + if (data_dst(i) /= 0.0_R8) then + data_dst(i) = data_dsttmp(i)/data_dst(i) + endif + end do + + ! temp diagnostics + call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after frac: ", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + + else if (trim(mapnorm) == 'one' .or. trim(mapnorm) == 'none') then + + !------------------------------------------------- + ! unity or no normalization + !------------------------------------------------- + + ! map source field to destination grid + mapindex = fldsSrc(n)%mapindex(destcomp) + + if (mapindex == mapnstod_consd) then + + call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapnstod), rc, & + zeroregion=ESMF_REGION_TOTAL) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! temp diagnostics + call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after nstod: ", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapconsd), rc, & + zeroregion=ESMF_REGION_SELECT) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! temp diagnostics + call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after consd: ", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + else if (mapindex == mapnstod_consf) then + call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapnstod), rc, & + zeroregion=ESMF_REGION_TOTAL) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! temp diagnostics + call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after nstod: ", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapconsf), rc, & + zeroregion=ESMF_REGION_SELECT) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! temp diagnostics + call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after consf: ", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + else + + call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapindex), rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end if + + ! obtain unity normalization factor and multiply interpolated field by reciprocal of normalization factor + if (trim(mapnorm) == 'one') then + call shr_nuopc_methods_FB_GetFldPtr(FBNormOne(mapindex), 'one', data_norm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_GetFldPtr(FBDst, trim(fldname), data_dst, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + do i= 1,size(data_dst) + if (data_norm(i) == 0.0_R8) then + data_dst(i) = 0.0_R8 + else + data_dst(i) = data_dst(i)/data_norm(i) + endif + enddo + end if ! mapnorm is 'one' + + end if ! mapnorm is 'one' or 'nne' + end if ! mapindex is not mapfcopy and field exists + + !if (dbug_flag > 1) then + call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, & + string=trim(subname) //' FBImp('//trim(compname(srccomp))//','//trim(compname(destcomp))//') ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + !end if + + end do ! loop over fields + + if (allocated(data_srctmp)) deallocate(data_srctmp) + if (allocated(data_dsttmp)) deallocate(data_dsttmp) + + call t_stopf('MED:'//subname) + + end subroutine med_map_FB_Regrid_Norm_All + + !================================================================================ + + subroutine med_map_FB_Regrid_Norm_Frac(fldnames, FBSrc, FBDst, & + FBFrac, mapnorm, RouteHandle, string, rc) + + ! ---------------------------------------------- + ! Map fldnames in source field bundle with appropriate fraction weighting + ! ---------------------------------------------- + + use ESMF , only: ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only: ESMF_LOGMSG_ERROR, ESMF_FAILURE + use ESMF , only: ESMF_FieldBundle, ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet + use ESMF , only: ESMF_RouteHandle, ESMF_RouteHandleIsCreated, ESMF_Field + use shr_nuopc_scalars_mod , only: flds_scalar_name + use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_Init + use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_Reset + use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_Clean + use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_GetFldPtr + use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_FieldRegrid + use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_FldChk + use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_Field_diagnose + use shr_nuopc_methods_mod , only: shr_nuopc_methods_ChkErr + use shr_nuopc_utils_mod , only: shr_nuopc_memcheck + use perf_mod , only: t_startf, t_stopf + + ! input/output variables + character(len=*) , intent(in) :: fldnames(:) + type(ESMF_FieldBundle) , intent(inout) :: FBSrc + type(ESMF_FieldBundle) , intent(inout) :: FBDst + type(ESMF_FieldBundle) , intent(in) :: FBFrac + character(len=*) , intent(in) :: mapnorm + type(ESMF_RouteHandle) , intent(inout) :: RouteHandle + character(len=*) , intent(in), optional :: string + integer , intent(out) :: rc + + ! local variables + integer :: i, n + type(ESMF_FieldBundle) :: FBSrcTmp ! temporary + type(ESMF_FieldBundle) :: FBNormSrc ! temporary + type(ESMF_FieldBundle) :: FBNormDst ! temporary + character(len=CS) :: lstring + character(len=CS) :: csize1, csize2 + real(R8), pointer :: data_srctmp(:) ! temporary + real(R8), pointer :: data_src(:) ! temporary + real(R8), pointer :: data_dst(:) ! temporary + real(R8), pointer :: data_srcnorm(:) ! temporary + real(R8), pointer :: data_dstnorm(:) ! temporary + real(R8), pointer :: data_frac(:) ! temporary + real(R8), pointer :: data_norm(:) ! temporary + integer :: dbrc + character(len=*), parameter :: subname='(module_MED_Map:med_map_Regrid_Norm)' + !------------------------------------------------------------------------------- + + call t_startf('MED:'//subname) + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + + call shr_nuopc_memcheck(subname, 1, mastertask) + + if (present(string)) then + lstring = trim(string) + else + lstring = " " + endif + + !------------------------------------------------- + ! Loop over all fields in the source field bundle and map them to + ! the destination field bundle accordingly + !------------------------------------------------- + + call shr_nuopc_methods_FB_reset(FBDst, value=czero, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1,size(fldnames) + + ! get pointer to source field data in FBSrc + call shr_nuopc_methods_FB_GetFldPtr(FBSrc, trim(fldnames(n)), data_src, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create a new temporary field bundle, FBSrcTmp that will contain field data on the source grid + if (.not. ESMF_FieldBundleIsCreated(FBSrcTmp)) then + call shr_nuopc_methods_FB_init(FBSrcTmp, flds_scalar_name, & + FBgeom=FBSrc, fieldNameList=(/'data_srctmp'/), name='data_srctmp', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_GetFldPtr(FBSrcTmp, 'data_srctmp', data_srctmp, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! create a temporary field bundle that will contain normalization on the source grid + if (.not. ESMF_FieldBundleIsCreated(FBNormSrc)) then + call shr_nuopc_methods_FB_init(FBout=FBNormSrc, flds_scalar_name=flds_scalar_name, & + FBgeom=FBSrc, fieldNameList=(/trim(mapnorm)/), name='normsrc', rc=rc) + if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + + call shr_nuopc_methods_FB_GetFldPtr(FBNormSrc, trim(mapnorm), data_srcnorm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + call shr_nuopc_methods_FB_reset(FBNormSrc, value=czero, rc=rc) + if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + + ! create a temporary field bundle that will contain normalization on the destination grid + if (.not. ESMF_FieldBundleIsCreated(FBNormDst)) then + call shr_nuopc_methods_FB_init(FBout=FBNormDst, flds_scalar_name=flds_scalar_name, & + FBgeom=FBDst, fieldNameList=(/trim(mapnorm)/), name='normdst', rc=rc) + if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + + call shr_nuopc_methods_FB_GetFldPtr(FBFrac, trim(mapnorm), data_frac, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + call shr_nuopc_methods_FB_reset(FBNormDst, value=czero, rc=rc) + if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + + ! error checks + if (size(data_srcnorm) /= size(data_frac)) then + call ESMF_LogWrite(trim(subname)//" fldname= "//trim(fldnames(n))//" mapnorm= "//trim(mapnorm), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + write(csize1,'(i8)') size(data_srcnorm) + write(csize2,'(i8)') size(data_frac) + call ESMF_LogWrite(trim(subname)//": ERROR data_normsrc size "//trim(csize1)//& + " and data_frac size "//trim(csize2)//" are inconsistent", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + else if (size(data_srcnorm) /= size(data_srctmp)) then + write(csize1,'(i8)') size(data_srcnorm) + write(csize2,'(i8)') size(data_srctmp) + call ESMF_LogWrite(trim(subname)//": ERROR data_srcnorm size "//trim(csize1)//& + " and data_srctmp size "//trim(csize2)//" are inconsistent", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + end if + + ! now fill in the values for data_srcnorm and data_srctmp - these are the two arrays needed for normalization + ! Note that FBsrcTmp will now have the data_srctmp value + do i = 1,size(data_frac) + data_srcnorm(i) = data_frac(i) + data_srctmp(i) = data_src(i) * data_frac(i) ! Multiply initial field by data_frac + end do + + ! regrid FBSrcTmp to FBDst + if (trim(fldnames(n)) == trim(flds_scalar_name)) then + call ESMF_LogWrite(trim(subname)//trim(lstring)//": skip : fld="//trim(fldnames(n)), & + ESMF_LOGMSG_INFO, rc=dbrc) + else + call shr_nuopc_methods_FB_FieldRegrid( FBSrcTmp, 'data_srctmp', FBDst, fldnames(n), RouteHandle, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + call shr_nuopc_methods_FB_FieldRegrid(FBNormSrc, mapnorm, FBNormDst, mapnorm, RouteHandle, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! multiply interpolated field (FBDst) by reciprocal of fraction on destination grid (FBNormDst) + call shr_nuopc_methods_FB_GetFldPtr(FBNormDst, trim(mapnorm), data_dstnorm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_GetFldPtr(FBDst, trim(fldnames(n)), data_dst, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + do i= 1,size(data_dst) + if (data_dstnorm(i) == 0.0_R8) then + data_dst(i) = 0.0_R8 + else + data_dst(i) = data_dst(i)/data_dstnorm(i) + endif + end do + + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldnames(n), & + string=trim(subname) //' Mapping (' // trim(fldnames(n)) // trim(lstring), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + end do ! loop over fields + + ! Clean up temporary field bundles + if (ESMF_FieldBundleIsCreated(FBSrcTmp)) then + call shr_nuopc_methods_FB_clean(FBSrcTmp, rc=rc) + if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + end if + if (ESMF_FieldBundleIsCreated(FBNormSrc)) then + call shr_nuopc_methods_FB_clean(FBNormSrc, rc=rc) + if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + end if + if (ESMF_FieldBundleIsCreated(FBNormDst)) then + call shr_nuopc_methods_FB_clean(FBNormDst, rc=rc) + if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + end if + call t_stopf('MED:'//subname) + + end subroutine med_map_FB_Regrid_Norm_Frac + +end module med_map_mod diff --git a/src/mediator/med_merge_mod.F90 b/src/mediator/med_merge_mod.F90 new file mode 100644 index 00000000..62d84c98 --- /dev/null +++ b/src/mediator/med_merge_mod.F90 @@ -0,0 +1,710 @@ +module med_merge_mod + + !----------------------------------------------------------------------------- + ! Performs merges from source field bundles to destination field bundle + !----------------------------------------------------------------------------- + + use med_constants_mod , only : R8, CL + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use med_constants_mod , only : spval_init => med_constants_spval_init + use med_constants_mod , only : spval => med_constants_spval + use med_constants_mod , only : czero => med_constants_czero + use shr_nuopc_methods_mod , only : ChkErr => shr_nuopc_methods_ChkErr + + implicit none + private + + public :: med_merge_auto + public :: med_merge_field + + interface med_merge_field ; module procedure & + med_merge_field_1D, & + med_merge_field_2D + end interface + + private :: med_merge_auto_field + + character(*),parameter :: u_FILE_u = & + __FILE__ + +!----------------------------------------------------------------------------- +contains +!----------------------------------------------------------------------------- + + subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, FBMed2, & + document, string, mastertask, rc) + + use ESMF , only : ESMF_FieldBundle + use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LogWrite, ESMF_LogMsg_Info + use ESMF , only : ESMF_LogSetError, ESMF_RC_OBJ_NOT_CREATED + use med_constants_mod , only : CL, CX, CS + use shr_string_mod , only : shr_string_listGetNum + use shr_string_mod , only : shr_string_listGetName + use esmFlds , only : compmed, compname + use esmFlds , only : shr_nuopc_fldList_type + use esmFlds , only : shr_nuopc_fldList_GetNumFlds + use esmFlds , only : shr_nuopc_fldList_GetFldInfo + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FldChk + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_GetNameN + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_reset + use med_internalstate_mod , only : logunit + use perf_mod , only : t_startf, t_stopf + + ! ---------------------------------------------- + ! Auto merge based on fldListTo info + ! ---------------------------------------------- + + ! input/output variables + character(len=*) , intent(in) :: compout_name ! component name for FBOut + type(ESMF_FieldBundle) , intent(inout) :: FBOut ! Merged output field bundle + type(ESMF_FieldBundle) , intent(inout) :: FBfrac ! Fraction data for FBOut + type(ESMF_FieldBundle) , intent(in) :: FBImp(:) ! Array of field bundles each mapping to the FBOut mesh + type(shr_nuopc_fldList_type) , intent(in) :: fldListTo ! Information for merging + type(ESMF_FieldBundle) , intent(in) , optional :: FBMed1 ! mediator field bundle + type(ESMF_FieldBundle) , intent(in) , optional :: FBMed2 ! mediator field bundle + logical , intent(in) :: document + character(len=*) , intent(in) :: string + logical , intent(in) :: mastertask + integer , intent(out) :: rc + + ! local variables + integer :: cnt + integer :: n,nf,nm,compsrc + character(CX) :: fldname, stdname + character(CX) :: merge_fields + character(CX) :: merge_field + character(CS) :: merge_type + character(CS) :: merge_fracname + integer :: dbrc + character(len=*),parameter :: subname=' (module_med_merge_mod: med_merge_auto)' + !--------------------------------------- + call t_startf('MED:'//subname) + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + rc = ESMF_SUCCESS + + call shr_nuopc_methods_FB_reset(FBOut, value=czero, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Want to loop over all of the fields in FBout here - and find the corresponding index in fldListTo(compxxx) + ! for that field name - then call the corresponding merge routine below appropriately + + call ESMF_FieldBundleGet(FBOut, fieldCount=cnt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Loop over all fields in field bundle FBOut + do n = 1,cnt + + ! Get the nth field name in FBexp + call shr_nuopc_methods_FB_getNameN(FBOut, n, fldname, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Loop over the field in fldListTo + do nf = 1,shr_nuopc_fldList_GetNumFlds(fldListTo) + + ! Determine if if there is a match of the fldList field name with the FBOut field name + call shr_nuopc_fldList_GetFldInfo(fldListTo, nf, stdname) + + if (trim(stdname) == trim(fldname)) then + + ! Loop over all possible source components in the merging arrays returned from the above call + ! If the merge field name from the source components is not set, then simply go to the next component + do compsrc = 1,size(FBImp) + + ! Determine the merge information for the import field + call shr_nuopc_fldList_GetFldInfo(fldListTo, nf, compsrc, merge_fields, merge_type, merge_fracname) + + ! If merge_field is a colon delimited string then cycle through every field - otherwise by default nm + ! will only equal 1 + do nm = 1,shr_string_listGetNum(merge_fields) + + call shr_string_listGetName(merge_fields, nm, merge_field) + + if (merge_type /= 'unset' .and. merge_field /= 'unset') then + + ! Perform merge + if (compsrc == compmed) then + + if (present(FBMed1) .and. present(FBMed2)) then + if (.not. ESMF_FieldBundleIsCreated(FBMed1)) then + call ESMF_LogSetError(ESMF_RC_OBJ_NOT_CREATED, & + msg="Field bundle FBMed1 not created.", & + line=__LINE__, file=u_FILE_u, rcToReturn=rc) + return + endif + if (.not. ESMF_FieldBundleIsCreated(FBMed2)) then + call ESMF_LogSetError(ESMF_RC_OBJ_NOT_CREATED, & + msg="Field bundle FBMed2 not created.", & + line=__LINE__, file=u_FILE_u, rcToReturn=rc) + return + endif + if (shr_nuopc_methods_FB_FldChk(FBMed1, trim(merge_field), rc=rc)) then + call med_merge_auto_field(trim(merge_type), & + FBOut, fldname, FB=FBMed1, FBFld=merge_field, FBw=FBfrac, fldw=trim(merge_fracname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + else if (shr_nuopc_methods_FB_FldChk(FBMed2, trim(merge_field), rc=rc)) then + call med_merge_auto_field(trim(merge_type), & + FBOut, fldname, FB=FBMed2, FBFld=merge_field, FBw=FBfrac, fldw=trim(merge_fracname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + else + call ESMF_LogWrite(trim(subname)//": ERROR merge_field = "//trim(merge_field)//" not found", & + ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + elseif (present(FBMed1)) then + if (.not. ESMF_FieldBundleIsCreated(FBMed1)) then + call ESMF_LogSetError(ESMF_RC_OBJ_NOT_CREATED, & + msg="Field bundle FBMed1 not created.", & + line=__LINE__, file=u_FILE_u, rcToReturn=rc) + return + endif + if (shr_nuopc_methods_FB_FldChk(FBMed1, trim(merge_field), rc=rc)) then + call med_merge_auto_field(trim(merge_type), & + FBOut, fldname, FB=FBMed1, FBFld=merge_field, FBw=FBfrac, fldw=trim(merge_fracname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + else + call ESMF_LogWrite(trim(subname)//": ERROR merge_field = "//trim(merge_field)//"not found", & + ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + + else if (ESMF_FieldBundleIsCreated(FBImp(compsrc), rc=rc)) then + + if (shr_nuopc_methods_FB_FldChk(FBImp(compsrc), trim(merge_field), rc=rc)) then + call med_merge_auto_field(trim(merge_type), & + FBOut, fldname, FB=FBImp(compsrc), FBFld=merge_field, FBw=FBfrac, fldw=trim(merge_fracname), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + end if ! end of single merge + + end if ! end of check of merge_type and merge_field not unset + end do ! end of nmerges loop + end do ! end of compsrc loop + end if ! end of check if stdname and fldname are the same + end do ! end of loop over fldsListTo + end do ! end of loop over fields in FBOut + + !--------------------------------------- + !--- clean up + !--------------------------------------- + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call t_stopf('MED:'//subname) + + end subroutine med_merge_auto + + !----------------------------------------------------------------------------- + + subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fldw, rc) + + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LogMsg_Error + use ESMF , only : ESMF_FieldBundle, ESMF_LogWrite, ESMF_LogMsg_Info + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FldChk + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_GetFldPtr + + character(len=*) ,intent(in) :: merge_type + type(ESMF_FieldBundle),intent(inout) :: FBout + character(len=*) ,intent(in) :: FBoutfld + type(ESMF_FieldBundle),intent(in) :: FB + character(len=*) ,intent(in) :: FBfld + type(ESMF_FieldBundle),intent(inout) :: FBw + character(len=*) ,intent(in) :: fldw + integer ,intent(out) :: rc + + ! local variables + real(R8), pointer :: dp1 (:), dp2(:,:) + real(R8), pointer :: dpf1(:), dpf2(:,:) + real(R8), pointer :: dpw1(:), dpw2(:,:) + integer :: lrank + integer :: dbrc + character(len=*),parameter :: subname=' (med_merge_mod: med_merge)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + !------------------------- + ! Error checks + !------------------------- + + if (merge_type == 'copy_with_weights' .or. merge_type == 'merge') then + if (trim(fldw) == 'unset') then + call ESMF_LogWrite(trim(subname)//": error required merge_fracname is not set", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + end if + if (.not. shr_nuopc_methods_FB_FldChk(FBw, trim(fldw), rc=rc)) then + call ESMF_LogWrite(trim(subname)//": error "//trim(fldw)//"is not in FBw", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + end if + end if + + !------------------------- + ! Get appropriate field pointers + !------------------------- + + call shr_nuopc_methods_FB_GetFldPtr(FBout, trim(FBoutfld), fldptr1=dp1, fldptr2=dp2, rank=lrank, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (merge_type == 'copy_with_weights' .or. merge_type == 'merge' .or. merge_type == 'sum_with_weights') then + if (lrank == 1) then + call shr_nuopc_methods_FB_GetFldPtr(FBw, trim(fldw), fldptr1=dpw1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else if (lrank == 2) then + call shr_nuopc_methods_FB_GetFldPtr(FBw, trim(fldw), fldptr2=dpw2, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + endif + + !------------------------- + ! Loop over all output fields and do the merge + !------------------------- + + ! Get field pointer to input field used in the merge + if (lrank == 1) then + call shr_nuopc_methods_FB_GetFldPtr(FB, trim(FBfld), fldptr1=dpf1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else if (lrank == 2) then + call shr_nuopc_methods_FB_GetFldPtr(FB, trim(FBfld), fldptr2=dpf2, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Do one of two types of merges (copy or merge) + if (trim(merge_type) == 'copy') then + if (lrank == 1) then + dp1(:) = dpf1(:) + else + dp2(:,:) = dpf2(:,:) + endif + else if (trim(merge_type) == 'copy_with_weights') then + if (lrank == 1) then + dp1(:) = dpf1(:)*dpw1(:) + else + dp2(:,:) = dpf2(:,:)*dpw2(:,:) + endif + else if (trim(merge_type) == 'merge') then + if (lrank == 1) then + dp1(:) = dp1(:) + dpf1(:)*dpw1(:) + else + dp2(:,:) = dp2(:,:) + dpf2(:,:)*dpw2(:,:) + endif + else if (trim(merge_type) == 'sum') then + if (lrank == 1) then + dp1(:) = dp1(:) + dpf1(:) + else + dp2(:,:) = dp2(:,:) + dpf2(:,:) + endif + else if (trim(merge_type) == 'sum_with_weights') then + if (lrank == 1) then + dp1(:) = dp1(:) + dpf1(:)*dpw1(:) + else + dp2(:,:) = dp2(:,:) + dpf2(:,:)*dpw2(:,:) + endif + else + call ESMF_LogWrite(trim(subname)//": merge type "//trim(merge_type)//" not supported", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + end if + + end subroutine med_merge_auto_field + + !----------------------------------------------------------------------------- + + subroutine med_merge_field_1D(FBout, fnameout, & + FBinA, fnameA, wgtA, & + FBinB, fnameB, wgtB, & + FBinC, fnameC, wgtC, & + FBinD, fnameD, wgtD, & + FBinE, fnameE, wgtE, rc) + + use ESMF , only : ESMF_FieldBundle, ESMF_LogWrite + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_ERROR + use ESMF , only : ESMF_LOGMSG_WARNING, ESMF_LOGMSG_INFO + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_GetFldPtr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FieldPtr_Compare + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FldChk + + ! ---------------------------------------------- + ! Supports up to a five way merge + ! ---------------------------------------------- + + ! input/output variabes + type(ESMF_FieldBundle) , intent(inout) :: FBout + character(len=*) , intent(in) :: fnameout + type(ESMF_FieldBundle) , intent(in) :: FBinA + character(len=*) , intent(in) :: fnameA + real(R8) , intent(in), pointer :: wgtA(:) + type(ESMF_FieldBundle) , intent(in), optional :: FBinB + character(len=*) , intent(in), optional :: fnameB + real(R8) , intent(in), optional, pointer :: wgtB(:) + type(ESMF_FieldBundle) , intent(in), optional :: FBinC + character(len=*) , intent(in), optional :: fnameC + real(R8) , intent(in), optional, pointer :: wgtC(:) + type(ESMF_FieldBundle) , intent(in), optional :: FBinD + character(len=*) , intent(in), optional :: fnameD + real(R8) , intent(in), optional, pointer :: wgtD(:) + type(ESMF_FieldBundle) , intent(in), optional :: FBinE + character(len=*) , intent(in), optional :: fnameE + real(R8) , intent(in), optional, pointer :: wgtE(:) + integer , intent(out) :: rc + + ! local variables + real(R8), pointer :: dataOut(:) + real(R8), pointer :: dataPtr(:) + real(R8), pointer :: wgt(:) + integer :: lb1,ub1,i,j,n + logical :: wgtfound, FBinfound + integer :: dbrc + character(len=*),parameter :: subname='(med_merge_fieldo_1d)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc=ESMF_SUCCESS + + ! check each field has a fieldname passed in + if ((present(FBinB) .and. .not.present(fnameB)) .or. & + (present(FBinC) .and. .not.present(fnameC)) .or. & + (present(FBinD) .and. .not.present(fnameD)) .or. & + (present(FBinE) .and. .not.present(fnameE))) then + + call ESMF_LogWrite(trim(subname)//": ERROR fname not present with FBin", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + if (.not. shr_nuopc_methods_FB_FldChk(FBout, trim(fnameout), rc=rc)) then + call ESMF_LogWrite(trim(subname)//": WARNING field not in FBout, skipping merge "//trim(fnameout), & + ESMF_LOGMSG_WARNING, line=__LINE__, file=u_FILE_u, rc=dbrc) + return + endif + + call shr_nuopc_methods_FB_GetFldPtr(FBout, trim(fnameout), fldptr1=dataOut, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + lb1 = lbound(dataOut,1) + ub1 = ubound(dataOut,1) + allocate(wgt(lb1:ub1)) + + dataOut = czero + + ! check that each field passed in actually exists, if not DO NOT do any merge + FBinfound = .true. + if (present(FBinB)) then + if (.not. shr_nuopc_methods_FB_FldChk(FBinB, trim(fnameB), rc=rc)) FBinfound = .false. + endif + if (present(FBinC)) then + if (.not. shr_nuopc_methods_FB_FldChk(FBinC, trim(fnameC), rc=rc)) FBinfound = .false. + endif + if (present(FBinD)) then + if (.not. shr_nuopc_methods_FB_FldChk(FBinD, trim(fnameD), rc=rc)) FBinfound = .false. + endif + if (present(FBinE)) then + if (.not. shr_nuopc_methods_FB_FldChk(FBinE, trim(fnameE), rc=rc)) FBinfound = .false. + endif + if (.not. FBinfound) then + call ESMF_LogWrite(trim(subname)//": WARNING field not found in FBin, skipping merge "//trim(fnameout), & + ESMF_LOGMSG_WARNING, line=__LINE__, file=u_FILE_u, rc=dbrc) + return + endif + + ! n=1,5 represents adding A to E inputs if they exist + do n = 1,5 + FBinfound = .false. + wgtfound = .false. + + if (n == 1) then + FBinfound = .true. + call shr_nuopc_methods_FB_GetFldPtr(FBinA, trim(fnameA), fldptr1=dataPtr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + wgtfound = .true. + wgt => wgtA + + elseif (n == 2 .and. present(FBinB)) then + FBinfound = .true. + call shr_nuopc_methods_FB_GetFldPtr(FBinB, trim(fnameB), fldptr1=dataPtr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (present(wgtB)) then + wgtfound = .true. + wgt => wgtB + endif + + elseif (n == 3 .and. present(FBinC)) then + FBinfound = .true. + call shr_nuopc_methods_FB_GetFldPtr(FBinC, trim(fnameC), fldptr1=dataPtr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (present(wgtC)) then + wgtfound = .true. + wgt => wgtC + endif + + elseif (n == 4 .and. present(FBinD)) then + FBinfound = .true. + call shr_nuopc_methods_FB_GetFldPtr(FBinD, trim(fnameD), fldptr1=dataPtr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (present(wgtD)) then + wgtfound = .true. + wgt => wgtD + endif + + elseif (n == 5 .and. present(FBinE)) then + FBinfound = .true. + call shr_nuopc_methods_FB_GetFldPtr(FBinE, trim(fnameE), fldptr1=dataPtr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (present(wgtE)) then + wgtfound = .true. + wgt => wgtE + endif + + endif + + if (FBinfound) then + if (.not.shr_nuopc_methods_FieldPtr_Compare(dataPtr, dataOut, subname, rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR FBin wrong size", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + if (wgtfound) then + if (.not.shr_nuopc_methods_FieldPtr_Compare(dataPtr, wgt, subname, rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR wgt wrong size", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + do i = lb1,ub1 + dataOut(i) = dataOut(i) + dataPtr(i) * wgt(i) + enddo + else + do i = lb1,ub1 + dataOut(i) = dataOut(i) + dataPtr(i) + enddo + endif ! wgtfound + + endif ! FBin found + enddo ! n + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine med_merge_field_1D + + !----------------------------------------------------------------------------- + + subroutine med_merge_field_2D(FBout, fnameout, & + FBinA, fnameA, wgtA, & + FBinB, fnameB, wgtB, & + FBinC, fnameC, wgtC, & + FBinD, fnameD, wgtD, & + FBinE, fnameE, wgtE, rc) + + use ESMF , only : ESMF_FieldBundle, ESMF_LogWrite + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_ERROR + use ESMF , only : ESMF_LOGMSG_WARNING, ESMF_LOGMSG_INFO + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_GetFldPtr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FieldPtr_Compare + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FldChk + + ! ---------------------------------------------- + ! Supports up to a five way merge + ! ---------------------------------------------- + + ! input/output arguments + type(ESMF_FieldBundle) , intent(inout) :: FBout + character(len=*) , intent(in) :: fnameout + type(ESMF_FieldBundle) , intent(in) :: FBinA + character(len=*) , intent(in) :: fnameA + real(R8) , intent(in), pointer :: wgtA(:,:) + type(ESMF_FieldBundle) , intent(in), optional :: FBinB + character(len=*) , intent(in), optional :: fnameB + real(R8) , intent(in), optional, pointer :: wgtB(:,:) + type(ESMF_FieldBundle) , intent(in), optional :: FBinC + character(len=*) , intent(in), optional :: fnameC + real(R8) , intent(in), optional, pointer :: wgtC(:,:) + type(ESMF_FieldBundle) , intent(in), optional :: FBinD + character(len=*) , intent(in), optional :: fnameD + real(R8) , intent(in), optional, pointer :: wgtD(:,:) + type(ESMF_FieldBundle) , intent(in), optional :: FBinE + character(len=*) , intent(in), optional :: fnameE + real(R8) , intent(in), optional, pointer :: wgtE(:,:) + integer , intent(out) :: rc + + ! local variables + real(R8), pointer :: dataOut(:,:) + real(R8), pointer :: dataPtr(:,:) + real(R8), pointer :: wgt(:,:) + integer :: lb1,ub1,lb2,ub2,i,j,n + logical :: wgtfound, FBinfound + integer :: dbrc + character(len=CL) :: errorName + character(len=*),parameter :: subname='(med_merge_field_2d)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc=ESMF_SUCCESS + + if (.not. shr_nuopc_methods_FB_FldChk(FBout, trim(fnameout), rc=rc)) then + call ESMF_LogWrite(trim(subname)//": WARNING field not in FBout, skipping merge "//& + trim(fnameout), ESMF_LOGMSG_WARNING, line=__LINE__, file=u_FILE_u, rc=dbrc) + return + endif + + call shr_nuopc_methods_FB_GetFldPtr(FBout, trim(fnameout), fldptr2=dataOut, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + lb1 = lbound(dataOut,1) + ub1 = ubound(dataOut,1) + lb2 = lbound(dataOut,2) + ub2 = ubound(dataOut,2) + allocate(wgt(lb1:ub1,lb2:ub2)) + + dataOut = czero + + ! check each field has a fieldname passed in + if ((present(FBinB) .and. .not.present(fnameB)) .or. & + (present(FBinC) .and. .not.present(fnameC)) .or. & + (present(FBinD) .and. .not.present(fnameD)) .or. & + (present(FBinE) .and. .not.present(fnameE))) then + call ESMF_LogWrite(trim(subname)//": ERROR fname not present with FBin", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + ! check that each field passed in actually exists, if not DO NOT do any merge + FBinfound = .true. + if (present(FBinB)) then + if (.not. shr_nuopc_methods_FB_FldChk(FBinB, trim(fnameB), rc=rc)) then + errorname=fnameB + FBinfound = .false. + end if + endif + if (present(FBinC)) then + if (.not. shr_nuopc_methods_FB_FldChk(FBinC, trim(fnameC), rc=rc)) then + errorname=fnameC + FBinfound = .false. + end if + endif + if (present(FBinD)) then + if (.not. shr_nuopc_methods_FB_FldChk(FBinD, trim(fnameD), rc=rc)) then + errorname=fnameD + FBinfound = .false. + end if + endif + if (present(FBinE)) then + if (.not. shr_nuopc_methods_FB_FldChk(FBinE, trim(fnameE), rc=rc)) then + errorname=fnameE + FBinfound = .false. + end if + endif + if (.not. FBinfound) then + call ESMF_LogWrite(trim(subname)//": ERROR field not found in FBin, skipping merge "//trim(errorName), & + ESMF_LOGMSG_WARNING, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + ! n=1,5 represents adding A to E inputs if they exist + do n = 1,5 + FBinfound = .false. + wgtfound = .false. + + if (n == 1) then + FBinfound = .true. + call shr_nuopc_methods_FB_GetFldPtr(FBinA, trim(fnameA), fldptr2=dataPtr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + wgtfound = .true. + wgt => wgtA + + elseif (n == 2 .and. present(FBinB)) then + FBinfound = .true. + call shr_nuopc_methods_FB_GetFldPtr(FBinB, trim(fnameB), fldptr2=dataPtr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (present(wgtB)) then + wgtfound = .true. + wgt => wgtB + endif + + elseif (n == 3 .and. present(FBinC)) then + FBinfound = .true. + call shr_nuopc_methods_FB_GetFldPtr(FBinC, trim(fnameC), fldptr2=dataPtr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (present(wgtC)) then + wgtfound = .true. + wgt => wgtC + endif + + elseif (n == 4 .and. present(FBinD)) then + FBinfound = .true. + call shr_nuopc_methods_FB_GetFldPtr(FBinD, trim(fnameD), fldptr2=dataPtr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (present(wgtD)) then + wgtfound = .true. + wgt => wgtD + endif + + elseif (n == 5 .and. present(FBinE)) then + FBinfound = .true. + call shr_nuopc_methods_FB_GetFldPtr(FBinE, trim(fnameE), fldptr2=dataPtr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (present(wgtE)) then + wgtfound = .true. + wgt => wgtE + endif + + endif + + if (FBinfound) then + if (.not.shr_nuopc_methods_FieldPtr_Compare(dataPtr, dataOut, subname, rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR FBin wrong size", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + if (wgtfound) then + if (.not.shr_nuopc_methods_FieldPtr_Compare(dataPtr, wgt, subname, rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR wgt wrong size", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + do j = lb2,ub2 + do i = lb1,ub1 + dataOut(i,j) = dataOut(i,j) + dataPtr(i,j) * wgt(i,j) + enddo + enddo + else + do j = lb2,ub2 + do i = lb1,ub1 + dataOut(i,j) = dataOut(i,j) + dataPtr(i,j) + enddo + enddo + endif ! wgtfound + + endif ! FBin found + enddo ! n + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine med_merge_field_2D + +end module med_merge_mod diff --git a/src/mediator/med_phases_aofluxes_mod.F90 b/src/mediator/med_phases_aofluxes_mod.F90 new file mode 100644 index 00000000..7e284975 --- /dev/null +++ b/src/mediator/med_phases_aofluxes_mod.F90 @@ -0,0 +1,672 @@ +module med_phases_aofluxes_mod + + use med_constants_mod , only : R8, CL, CX + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use med_internalstate_mod , only : mastertask + use shr_nuopc_utils_mod , only : shr_nuopc_memcheck + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_chkerr + use shr_nuopc_methods_mod , only : fldchk => shr_nuopc_methods_FB_FldChk + + implicit none + private + + !-------------------------------------------------------------------------- + ! Public routines + !-------------------------------------------------------------------------- + + public :: med_phases_aofluxes_run + + !-------------------------------------------------------------------------- + ! Private routines + !-------------------------------------------------------------------------- + + private :: med_phases_aofluxes_init + private :: med_aofluxes_init + private :: med_aofluxes_run + + !-------------------------------------------------------------------------- + ! Private data + !-------------------------------------------------------------------------- + + type aoflux_type + integer , pointer :: mask (:) ! ocn domain mask: 0 <=> inactive cell + real(R8) , pointer :: rmask (:) ! ocn domain mask: 0 <=> inactive cell + real(R8) , pointer :: lats (:) ! latitudes (degrees) + real(R8) , pointer :: lons (:) ! longitudes (degrees) + real(R8) , pointer :: uocn (:) ! ocn velocity, zonal + real(R8) , pointer :: vocn (:) ! ocn velocity, meridional + real(R8) , pointer :: tocn (:) ! ocean temperature + real(R8) , pointer :: zbot (:) ! atm level height + real(R8) , pointer :: ubot (:) ! atm velocity, zonal + real(R8) , pointer :: vbot (:) ! atm velocity, meridional + real(R8) , pointer :: thbot (:) ! atm potential T + real(R8) , pointer :: shum (:) ! atm specific humidity + real(R8) , pointer :: shum_16O (:) ! atm H2O tracer + real(R8) , pointer :: shum_HDO (:) ! atm HDO tracer + real(R8) , pointer :: shum_18O (:) ! atm H218O tracer + real(R8) , pointer :: roce_16O (:) ! ocn H2O ratio + real(R8) , pointer :: roce_HDO (:) ! ocn HDO ratio + real(R8) , pointer :: roce_18O (:) ! ocn H218O ratio + real(R8) , pointer :: pbot (:) ! atm bottom pressure + real(R8) , pointer :: qbot (:) ! atm bottom specific humidity + real(R8) , pointer :: dens (:) ! atm bottom density + real(R8) , pointer :: tbot (:) ! atm bottom surface T + real(R8) , pointer :: sen (:) ! heat flux: sensible + real(R8) , pointer :: lat (:) ! heat flux: latent + real(R8) , pointer :: lwup (:) ! lwup over ocean + real(R8) , pointer :: evap (:) ! water flux: evaporation + real(R8) , pointer :: evap_16O (:) ! H2O flux: evaporation + real(R8) , pointer :: evap_HDO (:) ! HDO flux: evaporation + real(R8) , pointer :: evap_18O (:) ! H218O flux: evaporation + real(R8) , pointer :: taux (:) ! wind stress, zonal + real(R8) , pointer :: tauy (:) ! wind stress, meridional + real(R8) , pointer :: tref (:) ! diagnostic: 2m ref T + real(R8) , pointer :: qref (:) ! diagnostic: 2m ref Q + real(R8) , pointer :: u10 (:) ! diagnostic: 10m wind speed + real(R8) , pointer :: duu10n (:) ! diagnostic: 10m wind speed squared + real(R8) , pointer :: lwdn (:) ! long wave, downward + real(R8) , pointer :: ustar (:) ! saved ustar + real(R8) , pointer :: re (:) ! saved re + real(R8) , pointer :: ssq (:) ! saved sq + real(R8) , pointer :: prec_gust (:) ! atm precip for convective gustiness (kg/m^3) + + ! Fields that are not obtained via GetFldPtr + real(R8) , pointer :: uGust (:) ! wind gust + end type aoflux_type + + ! The following three variables are obtained as attributes from gcomp + logical :: flds_wiso ! use case + logical :: compute_atm_dens + logical :: compute_atm_thbot + character(3) :: aoflux_grid + character(*), parameter :: u_FILE_u = & + __FILE__ + +!================================================================================ +contains +!================================================================================ + + subroutine med_phases_aofluxes_init(gcomp, aoflux, rc) + + use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_VMGet, ESMF_GridCompGet + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGERR_PASSTHRU + use ESMF , only : ESMF_SUCCESS, ESMF_LogFoundError + use NUOPC , only : NUOPC_CompAttributeGet + use esmFlds , only : compatm, compocn + use med_internalstate_mod , only : InternalState, mastertask + use shr_nuopc_scalars_mod , only : flds_scalar_name + use shr_nuopc_scalars_mod , only : flds_scalar_num + use perf_mod , only : t_startf, t_stopf + + !----------------------------------------------------------------------- + ! Initialize ocn/atm flux calculations + !----------------------------------------------------------------------- + + ! input/output variables + type(ESMF_GridComp) :: gcomp + type(aoflux_type) , intent(inout) :: aoflux + integer , intent(out) :: rc + + ! Local variables + character(3) :: aoflux_grid + character(len=256) :: cvalue + type(InternalState) :: is_local + integer :: localPet + type(ESMF_VM) :: vm + integer :: dbrc + character(len=*),parameter :: subname='(med_phases_aofluxes_init)' + !--------------------------------------- + call t_startf('MED:'//subname) + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + call ESMF_VMGet(vm, localPet=localPet, rc=rc) + mastertask = .false. + if (localPet == 0) mastertask=.true. + + ! Get the internal state from Component. + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Determine src and dst comps depending on the aoflux_grid setting + + call NUOPC_CompAttributeGet(gcomp, name='aoflux_grid', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) aoflux_grid + + if (trim(aoflux_grid) == 'ocn') then + + ! Create FBMed_aoflux_o (field bundle on the ocean grid) + call med_aofluxes_init(gcomp, aoflux, & + FBAtm=is_local%wrap%FBImp(compatm,compocn), & + FBOcn=is_local%wrap%FBImp(compocn,compocn), & + FBFrac=is_local%wrap%FBfrac(compocn), & + FBMed_aoflux=is_local%wrap%FBMed_aoflux_o, & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + else if (trim(aoflux_grid) == 'atm') then + + ! Create FBMed_aoflux_a (field bundle on the atmosphere grid) + call med_aofluxes_init(gcomp, aoflux, & + FBAtm=is_local%wrap%FBImp(compatm,compatm), & + FBOcn=is_local%wrap%FBImp(compocn,compatm), & + FBFrac=is_local%wrap%FBfrac(compatm), & + FBMed_aoflux=is_local%wrap%FBMed_aoflux_a, & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + else + + call ESMF_LogWrite(trim(subname)//' aoflux_grid = '//trim(aoflux_grid)//' not available', & + ESMF_LOGMSG_INFO, rc=dbrc) + return + + end if + call t_stopf('MED:'//subname) + + end subroutine med_phases_aofluxes_init + +!================================================================================ + + subroutine med_phases_aofluxes_run(gcomp, rc) + + use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_GridCompGet + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use NUOPC , only : NUOPC_IsConnected, NUOPC_CompAttributeGet + use med_internalstate_mod , only : InternalState + use med_map_mod , only : med_map_FB_Regrid_Norm + use esmFlds , only : fldListFr + use esmFlds , only : compatm, compocn, compname + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use perf_mod , only : t_startf, t_stopf + + !----------------------------------------------------------------------- + ! Compute atm/ocn fluxes + !----------------------------------------------------------------------- + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + type(ESMF_Clock) :: clock + character(CL) :: cvalue + character(CL) :: aoflux_grid + type(aoflux_type), save :: aoflux + logical, save :: first_call = .true. + integer :: dbrc + character(len=*),parameter :: subname='(med_phases_aofluxes)' + !--------------------------------------- + call t_startf('MED:'//subname) + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + call shr_nuopc_memcheck(subname, 5, mastertask) + ! Get the clock from the mediator Component + call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Get the internal state from the mediator Component. + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Initialize aoflux instance + if (first_call) then + call med_phases_aofluxes_init(gcomp, aoflux, rc) + first_call = .false. + end if + + ! Determine source and destination comps depending on the aoflux_grid setting + call NUOPC_CompAttributeGet(gcomp, name='aoflux_grid', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) aoflux_grid + + if (trim(aoflux_grid) == 'ocn') then + + ! TODO(mvertens, 2019-01-12): ONLY regrid atm import fields that are needed for the atm/ocn flux calculation + + ! Regrid atm import field bundle from atm to ocn grid as input for ocn/atm flux calculation + call med_map_FB_Regrid_Norm( & + fldListFr(compatm)%flds, compatm, compocn, & + is_local%wrap%FBImp(compatm,compatm), & + is_local%wrap%FBImp(compatm,compocn), & + is_local%wrap%FBFrac(compatm), & + is_local%wrap%FBNormOne(compatm,compocn,:), & + is_local%wrap%RH(compatm,compocn,:), & + string=trim(compname(compatm))//'2'//trim(compname(compocn)), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Calculate atm/ocn fluxes on the destination grid + call med_aofluxes_run(gcomp, aoflux, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBMed_aoflux_o, & + string=trim(subname) //' FBAMed_aoflux_o' , rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + else if (trim(aoflux_grid) == 'atm') then + + call med_map_FB_Regrid_Norm( & + fldListFr(compocn)%flds, compocn, compatm, & + is_local%wrap%FBImp(compocn,compocn), & + is_local%wrap%FBImp(compocn,compatm), & + is_local%wrap%FBFrac(compocn), & + is_local%wrap%FBNormOne(compocn,compatm,:), & + is_local%wrap%RH(compocn,compatm,:), & + string=trim(compname(compocn))//'2'//trim(compname(compatm)), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBImp(compocn,compatm), & + string=trim(subname) //' FBImp('//trim(compname(compocn))//','//trim(compname(compatm))//') ', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! Calculate atm/ocn fluxes on the destination grid + call med_aofluxes_run(gcomp, aoflux, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBImp(compocn,compatm), & + string=trim(subname) //' FBImp('//trim(compname(compocn))//','//trim(compname(compatm))//') ', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + else + + call ESMF_LogWrite(trim(subname)//' aoflux_grid = '//trim(aoflux_grid)//' not available', & + ESMF_LOGMSG_INFO, rc=dbrc) + return + + end if + call t_stopf('MED:'//subname) + + end subroutine med_phases_aofluxes_run + +!================================================================================ + + subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, rc) + + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError + use ESMF , only : ESMF_SUCCESS, ESMF_LOGERR_PASSTHRU + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_VM + use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldBundle, ESMF_VMGet + use NUOPC , only : NUOPC_CompAttributeGet + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_GetFldPtr + use perf_mod , only : t_startf, t_stopf + + !----------------------------------------------------------------------- + ! Initialize pointers to the module variables + !----------------------------------------------------------------------- + + ! input/output variables + type(ESMF_GridComp) :: gcomp + type(aoflux_type) , intent(inout) :: aoflux + type(ESMF_FieldBundle) , intent(in) :: FBAtm ! Atm Import fields on aoflux grid + type(ESMF_FieldBundle) , intent(in) :: FBOcn ! Ocn Import fields on aoflux grid + type(ESMF_FieldBundle) , intent(in) :: FBfrac ! Fraction data for various components, on their grid + type(ESMF_FieldBundle) , intent(inout) :: FBMed_aoflux ! Ocn albedos computed in mediator + integer , intent(out) :: rc + + ! local variables + type(ESMF_VM) :: vm + integer :: iam + integer :: n + integer :: lsize + real(R8), pointer :: ofrac(:) + real(R8), pointer :: ifrac(:) + character(CL) :: cvalue + logical :: flds_wiso ! use case + integer :: dbrc + character(len=CX) :: tmpstr + character(*),parameter :: subName = '(med_aofluxes_init) ' + !----------------------------------------------------------------------- + + call t_startf('MED:'//subname) + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + call shr_nuopc_memcheck(subname, 5, mastertask) + ! The following is for debugging + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + !---------------------------------- + ! get attributes that are set as module variables + !---------------------------------- + + call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + read(cvalue,*) flds_wiso + + call NUOPC_CompAttributeGet(gcomp, name='aoflux_grid', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) aoflux_grid + + !---------------------------------- + ! atm/ocn fields + !---------------------------------- + + call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='So_tref', fldptr1=aoflux%tref, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='So_qref', fldptr1=aoflux%qref, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='So_ustar', fldptr1=aoflux%ustar, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='So_re', fldptr1=aoflux%re, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='So_ssq', fldptr1=aoflux%ssq, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='So_u10', fldptr1=aoflux%u10, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='So_duu10n', fldptr1=aoflux%duu10n, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='Faox_taux', fldptr1=aoflux%taux, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='Faox_tauy', fldptr1=aoflux%tauy, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='Faox_lat', fldptr1=aoflux%lat, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='Faox_sen', fldptr1=aoflux%sen, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='Faox_evap', fldptr1=aoflux%evap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + lsize = size(aoflux%evap) + if (flds_wiso) then + call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='Faox_evap_16O', fldptr1=aoflux%evap_16O, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='Faox_evap_18O', fldptr1=aoflux%evap_18O, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='Faox_evap_HDO', fldptr1=aoflux%evap_HDO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + allocate(aoflux%evap_16O(lsize)); aoflux%evap_16O(:) = 0._R8 + allocate(aoflux%evap_18O(lsize)); aoflux%evap_18O(:) = 0._R8 + allocate(aoflux%evap_HDO(lsize)); aoflux%evap_HDO(:) = 0._R8 + end if + + call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='Faox_lwup', fldptr1=aoflux%lwup, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + !---------------------------------- + ! Ocn import fields + !---------------------------------- + + call shr_nuopc_methods_FB_GetFldPtr(FBOcn, fldname='So_omask', fldptr1=aoflux%rmask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBOcn, fldname='So_t', fldptr1=aoflux%tocn, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBOcn, fldname='So_u', fldptr1=aoflux%uocn, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBOcn, fldname='So_v', fldptr1=aoflux%vocn, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (flds_wiso) then + call shr_nuopc_methods_FB_GetFldPtr(FBOcn, fldname='So_roce_16O', fldptr1=aoflux%roce_16O, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBOcn, fldname='So_roce_18O', fldptr1=aoflux%roce_18O, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBOcn, fldname='So_roce_HDO', fldptr1=aoflux%roce_HDO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + allocate(aoflux%roce_16O(lsize)); aoflux%roce_16O(:) = 0._R8 + allocate(aoflux%roce_18O(lsize)); aoflux%roce_18O(:) = 0._R8 + allocate(aoflux%roce_HDO(lsize)); aoflux%roce_HDO(:) = 0._R8 + end if + + !---------------------------------- + ! Atm import fields + !---------------------------------- + + call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Sa_z', fldptr1=aoflux%zbot, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Sa_u', fldptr1=aoflux%ubot, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Sa_v', fldptr1=aoflux%vbot, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Sa_tbot', fldptr1=aoflux%tbot, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! bottom level potential temperature will need to be computed if not received from the atm + if (fldchk(FBAtm, 'Sa_ptem', rc=rc)) then + call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Sa_ptem', fldptr1=aoflux%thbot, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + compute_atm_thbot = .false. + else + allocate(aoflux%thbot(lsize)) + compute_atm_thbot = .true. + end if + + ! bottom level density will need to be computed if not received from the atm + if (fldchk(FBAtm, 'Sa_dens', rc=rc)) then + call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Sa_dens', fldptr1=aoflux%dens, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + compute_atm_dens = .false. + else + compute_atm_dens = .true. + allocate(aoflux%dens(lsize)) + end if + + ! if either density or potential temperature are computed, will need bottom level pressure + if (compute_atm_dens .or. compute_atm_thbot) then + call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Sa_pbot', fldptr1=aoflux%pbot, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Sa_shum', fldptr1=aoflux%shum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (flds_wiso) then + call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Sa_shum_16O', fldptr1=aoflux%shum_16O, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Sa_shum_18O', fldptr1=aoflux%shum_18O, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Sa_shum_HDO', fldptr1=aoflux%shum_HDO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + allocate(aoflux%shum_16O(lsize)); aoflux%shum_16O(:) = 0._R8 + allocate(aoflux%shum_18O(lsize)); aoflux%shum_18O(:) = 0._R8 + allocate(aoflux%shum_HDO(lsize)); aoflux%shum_HDO(:) = 0._R8 + end if + + ! Optional field used for gust parameterization + if ( fldchk(FBAtm, 'Faxa_rainc', rc=rc)) then + call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Faxa_rainc', fldptr1=aoflux%prec_gust, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + aoflux%prec_gust(:) = 0.0_R8 + end if + + !---------------------------------- + ! Fields that are not obtained via GetFldPtr + !---------------------------------- + allocate(aoflux%uGust(lsize)) + aoflux%uGust(:) = 0.0_R8 + + !---------------------------------- + ! setup the compute mask. + !---------------------------------- + + ! allocate grid mask fields + ! default compute everywhere, then "turn off" gridcells + allocate(aoflux%mask(lsize)) + aoflux%mask(:) = 1 + + write(tmpstr,'(i12,g22.12,i12)') lsize,sum(aoflux%rmask),sum(aoflux%mask) + call ESMF_LogWrite(trim(subname)//" : maskA= "//trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + where (aoflux%rmask(:) == 0._R8) aoflux%mask(:) = 0 ! like nint + + write(tmpstr,'(i12,g22.12,i12)') lsize,sum(aoflux%rmask),sum(aoflux%mask) + call ESMF_LogWrite(trim(subname)//" : maskB= "//trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + ! TODO: need to check if this logic is correct + ! then check ofrac + ifrac + ! call shr_nuopc_methods_FB_getFldPtr(FBFrac , fldname='ofrac' , fldptr1=ofrac, rc=rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + ! call shr_nuopc_methods_FB_getFldPtr(FBFrac , fldname='ifrac' , fldptr1=ifrac, rc=rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + ! where (ofrac(:) + ifrac(:) <= 0.0_R8) mask(:) = 0 + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + call t_stopf('MED:'//subname) + + end subroutine med_aofluxes_init + +!=============================================================================== + + subroutine med_aofluxes_run(gcomp, aoflux, rc) + + use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time, ESMF_TimeInterval + use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_TimeIntervalGet + use ESMF , only : ESMF_LogWrite, ESMF_LogMsg_Info + use NUOPC , only : NUOPC_CompAttributeGet + use shr_flux_mod , only : shr_flux_atmocn, shr_flux_adjust_constants + use perf_mod , only : t_startf, t_stopf + + !----------------------------------------------------------------------- + ! Determine atm/ocn fluxes eother on atm or on ocean grid + ! The module arrays are set via pointers the the mediator internal states + ! in med_ocnatm_init and are used below. + !----------------------------------------------------------------------- + + ! Arguments + type(ESMF_GridComp) :: gcomp + type(aoflux_type) , intent(inout) :: aoflux + integer , intent(out) :: rc + ! + ! Local variables + character(CL) :: cvalue + integer :: n,i ! indices + integer :: lsize ! local size + real(R8) :: gust_fac = huge(1.0_R8) ! wind gust factor + real(R8) :: flux_convergence ! convergence criteria for imlicit flux computation + integer :: flux_max_iteration ! maximum number of iterations for convergence + logical :: coldair_outbreak_mod ! cold air outbreak adjustment (Mahrt & Sun 1995,MWR) + character(len=CX) :: tmpstr + logical,save :: first_call = .true. + character(*),parameter :: subName = '(med_aofluxes_run) ' + !----------------------------------------------------------------------- + call t_startf('MED:'//subname) + + !---------------------------------- + ! Get config variables on first call + !---------------------------------- + + if (first_call) then + call NUOPC_CompAttributeGet(gcomp, name='gust_fac', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) gust_fac + + call NUOPC_CompAttributeGet(gcomp, name='coldair_outbreak_mod', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) coldair_outbreak_mod + + call NUOPC_CompAttributeGet(gcomp, name='flux_max_iteration', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) flux_max_iteration + + call NUOPC_CompAttributeGet(gcomp, name='flux_convergence', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) flux_convergence + + call shr_flux_adjust_constants(& + flux_convergence_tolerance=flux_convergence, & + flux_convergence_max_iteration=flux_max_iteration, & + coldair_outbreak_mod=coldair_outbreak_mod) + + first_call = .false. + end if + + !---------------------------------- + ! Determine the compute mask + !---------------------------------- + + ! Prefer to compute just where ocean exists, so setup a mask here. + ! this could be run with either the ocean or atm grid so need to be careful. + ! really want the ocean mask on ocean grid or ocean mask mapped to atm grid, + ! but do not have access to the ocean mask mapped to the atm grid. + ! the dom mask is a good place to start, on ocean grid, it should be what we want, + ! on the atm grid, it's just all 1's so not very useful. + ! next look at ofrac+ifrac in fractions. want to compute on all non-land points. + ! using ofrac alone will exclude points that are currently all sea ice but that later + ! could be less that 100% covered in ice. + + lsize = size(aoflux%mask) + + write(tmpstr,'(i12,g22.12,i12)') lsize,sum(aoflux%rmask),sum(aoflux%mask) + call ESMF_LogWrite(trim(subname)//" : maskA= "//trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + aoflux%mask(:) = 1 + where (aoflux%rmask(:) == 0._R8) aoflux%mask(:) = 0 ! like nint + + write(tmpstr,'(i12,g22.12,i12)') lsize,sum(aoflux%rmask),sum(aoflux%mask) + call ESMF_LogWrite(trim(subname)//" : maskB= "//trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + write(tmpstr,'(3i12)') lsize,size(aoflux%mask),sum(aoflux%mask) + call ESMF_LogWrite(trim(subname)//" : mask= "//trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + + !---------------------------------- + ! Update atmosphere/ocean surface fluxes + !---------------------------------- + + if (associated(aoflux%prec_gust)) then + do n = 1,lsize + !aoflux%uGust(n) = 1.5_R8*sqrt(uocn(n)**2 + vocn(n)**2) ! there is no wind gust data from ocn + aoflux%uGust(n) = 0.0_R8 + end do + end if + + if (compute_atm_thbot) then + do n = 1,lsize + if (aoflux%mask(n) /= 0._r8) then + aoflux%thbot(n) = aoflux%tbot(n)*((100000._R8/aoflux%pbot(n))**0.286_R8) + end if + end do + end if + if (compute_atm_dens) then + do n = 1,lsize + if (aoflux%mask(n) /= 0._r8) then + aoflux%dens(n) = aoflux%pbot(n)/(287.058_R8*(1._R8 + 0.608_R8*aoflux%shum(n))*aoflux%tbot(n)) + end if + end do + end if + + call shr_flux_atmocn (& + lsize, aoflux%zbot, aoflux%ubot, aoflux%vbot, aoflux%thbot, aoflux%prec_gust, gust_fac, & + aoflux%shum, aoflux%shum_16O, aoflux%shum_HDO, aoflux%shum_18O, aoflux%dens , & + aoflux%tbot, aoflux%uocn, aoflux%vocn, & + aoflux%tocn, aoflux%mask, aoflux%sen, aoflux%lat, aoflux%lwup, & + aoflux%roce_16O, aoflux%roce_HDO, aoflux%roce_18O, & + aoflux%evap, aoflux%evap_16O, aoflux%evap_HDO, aoflux%evap_18O, & + aoflux%taux, aoflux%tauy, aoflux%tref, aoflux%qref, & + aoflux%duu10n, ustar_sv=aoflux%ustar, re_sv=aoflux%re, ssq_sv=aoflux%ssq, & + missval = 0.0_r8) + + do n = 1,lsize + if (aoflux%mask(n) /= 0) then + aoflux%u10(n) = sqrt(aoflux%duu10n(n)) + end if + enddo + call t_stopf('MED:'//subname) + + end subroutine med_aofluxes_run + +end module med_phases_aofluxes_mod diff --git a/src/mediator/med_phases_history_mod.F90 b/src/mediator/med_phases_history_mod.F90 new file mode 100644 index 00000000..e118555f --- /dev/null +++ b/src/mediator/med_phases_history_mod.F90 @@ -0,0 +1,312 @@ +module med_phases_history_mod + + !----------------------------------------------------------------------------- + ! Mediator Phases + !----------------------------------------------------------------------------- + + use ESMF, only : ESMF_Alarm + + implicit none + private + + character(*) , parameter :: u_FILE_u = __FILE__ + type(ESMF_Alarm) :: AlarmHist + type(ESMF_Alarm) :: AlarmHistAvg + + public :: med_phases_history_write + +!=============================================================================== +contains +!=============================================================================== + + subroutine med_phases_history_write(gcomp, rc) + + ! Write mediator history file + + use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_Clock, ESMF_Time, ESMF_TimeInterval, ESMF_CalKind_Flag + use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_ClockGetNextTime, ESMF_VMGet, ESMF_TimeGet + use ESMF , only : ESMF_TimeIntervalGet, ESMF_AlarmIsRinging, ESMF_AlarmRingerOff + use ESMF , only : ESMF_CALKIND_GREGORIAN, ESMF_CALKIND_NOLEAP + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : operator(==), operator(-) + use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_MAXSTR, ESMF_ClockPrint, ESMF_AlarmIsCreated + use NUOPC , only : NUOPC_CompAttributeGet + use shr_cal_mod , only : shr_cal_ymd2date + use esmFlds , only : compatm, complnd, compocn, compice, comprof, compglc, ncomps, compname + use esmFlds , only : fldListFr, fldListTo + use shr_nuopc_scalars_mod , only : flds_scalar_index_nx, flds_scalar_index_ny + use shr_nuopc_scalars_mod , only : flds_scalar_name, flds_scalar_num + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_reset + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_GetFldPtr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_accum + use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_GetScalar + use shr_nuopc_time_mod , only : shr_nuopc_time_alarmInit + use med_constants_mod , only : dbug_flag =>med_constants_dbug_flag + use med_constants_mod , only : SecPerDay =>med_constants_SecPerDay + use med_constants_mod , only : R8, CL, CS, IN + use med_constants_mod , only : med_constants_noleap, med_constants_gregorian + use med_infodata_mod , only : med_infodata, med_infodata_GetData + use med_map_mod , only : med_map_FB_Regrid_Norm + use med_internalstate_mod , only : InternalState, mastertask + use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef + use med_io_mod , only : med_io_close, med_io_date2yyyymmdd + use med_io_mod , only : med_io_sec2hms + use perf_mod , only : t_startf, t_stopf + ! Input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_VM) :: vm + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currtime + type(ESMF_Time) :: reftime + type(ESMF_Time) :: starttime + type(ESMF_Time) :: nexttime + type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time + type(ESMF_CalKind_Flag) :: calkindflag + character(len=64) :: currtimestr + character(len=64) :: nexttimestr + type(InternalState) :: is_local + character(CS) :: histavg_option ! Histavg option units + integer :: i,j,m,n,n1,ncnt + integer :: start_ymd ! Starting date YYYYMMDD + integer :: start_tod ! Starting time-of-day (s) + integer :: nx,ny ! global grid size + integer :: yr,mon,day,sec ! time units + real(r8) :: rval ! real tmp value + real(r8) :: dayssince ! Time interval since reference time + integer :: fk ! index + character(CL) :: time_units ! units of time variable + character(CL) :: calendar ! calendar type + character(CL) :: case_name ! case name + character(CL) :: hist_file ! Local path to history filename + character(CS) :: cpl_inst_tag ! instance tag + character(CL) :: cvalue ! attribute string + character(CL) :: freq_option ! freq_option setting (ndays, nsteps, etc) + integer :: freq_n ! freq_n setting relative to freq_option + logical :: alarmIsOn ! generic alarm flag + real(r8) :: tbnds(2) ! CF1.0 time bounds + logical :: whead,wdata ! for writing restart/history cdf files + integer :: dbrc + integer :: iam + logical,save :: first_call = .true. + character(len=*), parameter :: subname='(med_phases_history_write)' + logical :: isPresent + + !--------------------------------------- + call t_startf('MED:'//subname) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + !--------------------------------------- + ! --- Get the communicator and localpet + !--------------------------------------- + + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if(isPresent) then + call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', value=cpl_inst_tag, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else + cpl_inst_tag = "" + endif + !--------------------------------------- + ! --- Get the clock info + !--------------------------------------- + + call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(clock, currtime=currtime, reftime=reftime, starttime=starttime, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(clock, calkindflag=calkindflag, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (calkindflag == ESMF_CALKIND_GREGORIAN) then + calendar = med_constants_gregorian + elseif (calkindflag == ESMF_CALKIND_NOLEAP) then + calendar = med_constants_noleap + else + call ESMF_LogWrite(trim(subname)//' ERROR: calendar not supported', ESMF_LOGMSG_ERROR, rc=dbrc) + rc=ESMF_Failure + return + endif + + call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO, rc=dbrc) + endif + + call ESMF_TimeGet(nexttime,yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": nexttime = "//trim(nexttimestr), ESMF_LOGMSG_INFO, rc=dbrc) + endif + timediff = nexttime - reftime + call ESMF_TimeIntervalGet(timediff, d=day, s=sec, rc=rc) + dayssince = day + sec/real(SecPerDay,R8) + + call ESMF_TimeGet(reftime, yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) + call shr_cal_ymd2date(yr,mon,day,start_ymd) + start_tod = sec + time_units = 'days since ' & + // trim(med_io_date2yyyymmdd(start_ymd)) // ' ' // med_io_sec2hms(start_tod) + + !--------------------------------------- + ! --- History Alarms + !--------------------------------------- + + if (.not. ESMF_AlarmIsCreated(AlarmHist, rc=rc)) then + ! Set instantaneous history output alarm + call NUOPC_CompAttributeGet(gcomp, name='history_option', value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + freq_option = cvalue + + call NUOPC_CompAttributeGet(gcomp, name='history_n', value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) freq_n + + call ESMF_LogWrite(trim(subname)//" init history alarm with option, n = "//& + trim(freq_option)//","//trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + + call shr_nuopc_time_alarmInit(clock, AlarmHist, option=freq_option, opt_n=freq_n, & + RefTime=RefTime, alarmname='history', rc=rc) + endif + + if (ESMF_AlarmIsRinging(AlarmHist, rc=rc)) then + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + alarmIsOn = .true. + call ESMF_AlarmRingerOff( AlarmHist, rc=rc ) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return +#if DEBUG + if (mastertask) then + call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//& + " history alarm for: ", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if +#endif + else + alarmisOn = .false. + endif + + ! Set average history output alarm TODO: fix the following + ! if (.not. ESMF_AlarmIsCreated(AlarmHistAvg, rc=rc)) then + ! call NUOPC_CompAttributeGet(gcomp, name="histavg_option", value=histavg_option, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! freq_option = cvalue + ! call NUOPC_CompAttributeGet(gcomp, name="histavg_n", value=cvalue, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) freq_n + ! call shr_nuopc_time_alarmInit(clock, AlarmHistAvg, option=freq_option, opt_n=freq_n, & + ! RefTime=RefTime, alarmname='history_avg', rc=rc) + ! end if + ! if (ESMF_AlarmIsRinging(AlarmHistAvg, rc=rc)) then + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! alarmIsOn = .true. + ! call ESMF_AlarmRingerOff( AlarmHist, rc=rc ) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! else + ! alarmisOn = .false. + ! endif + + !--------------------------------------- + ! --- History File + ! Use nexttimestr rather than currtimestr here since that is the time at the end of + ! the timestep and is preferred for history file names + !--------------------------------------- + + if (alarmIsOn) then + write(hist_file,"(6a)") & + trim(case_name), '.cpl',trim(cpl_inst_tag),'.hi.', trim(nexttimestr),'.nc' + call ESMF_LogWrite(trim(subname)//": write "//trim(hist_file), ESMF_LOGMSG_INFO, rc=dbrc) + call med_io_wopen(hist_file, vm, iam, clobber=.true.) + + do m = 1,2 + whead=.false. + wdata=.false. + if (m == 1) then + whead=.true. + elseif (m == 2) then + wdata=.true. + call med_io_enddef(hist_file) + endif + + tbnds = dayssince + + call ESMF_LogWrite(trim(subname)//": time "//trim(time_units), ESMF_LOGMSG_INFO, rc=dbrc) + if (tbnds(1) >= tbnds(2)) then + call med_io_write(hist_file, iam, & + time_units=time_units, time_cal=calendar, time_val=dayssince, & + whead=whead, wdata=wdata) + else + call med_io_write(hist_file, iam, & + time_units=time_units, time_cal=calendar, time_val=dayssince, & + whead=whead, wdata=wdata, tbnds=tbnds) + endif + + do n = 1,ncomps + if (is_local%wrap%comp_present(n)) then + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then + call med_infodata_GetData(med_infodata, ncomp=n, nx=nx, ny=ny) + call med_io_write(hist_file, iam, is_local%wrap%FBimp(n,n), & + nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Imp', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then + call med_infodata_GetData(med_infodata, ncomp=n, nx=nx, ny=ny) + call med_io_write(hist_file, iam, is_local%wrap%FBexp(n), & + nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Exp', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + endif + enddo + + enddo + + call med_io_close(hist_file, iam) + + endif + + !--------------------------------------- + !--- clean up + !--------------------------------------- + + first_call = .false. + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + call t_stopf('MED:'//subname) + + end subroutine med_phases_history_write + +end module med_phases_history_mod diff --git a/src/mediator/med_phases_ocnalb_mod.F90 b/src/mediator/med_phases_ocnalb_mod.F90 new file mode 100644 index 00000000..9f07eac4 --- /dev/null +++ b/src/mediator/med_phases_ocnalb_mod.F90 @@ -0,0 +1,441 @@ +module med_phases_ocnalb_mod + + use med_constants_mod, only : R8 + + implicit none + private + + !-------------------------------------------------------------------------- + ! Public interfaces + !-------------------------------------------------------------------------- + + public med_phases_ocnalb_run + public med_phases_ocnalb_mapo2a + + !-------------------------------------------------------------------------- + ! Private interfaces + !-------------------------------------------------------------------------- + + private med_phases_ocnalb_init + + !-------------------------------------------------------------------------- + ! Private data + !-------------------------------------------------------------------------- + + type ocnalb_type + real(r8) , pointer :: lats (:) ! latitudes (degrees) + real(r8) , pointer :: lons (:) ! longitudes (degrees) + integer , pointer :: mask (:) ! ocn domain mask: 0 <=> inactive cell + real(r8) , pointer :: anidr (:) ! albedo: near infrared, direct + real(r8) , pointer :: avsdr (:) ! albedo: visible , direct + real(r8) , pointer :: anidf (:) ! albedo: near infrared, diffuse + real(r8) , pointer :: avsdf (:) ! albedo: visible , diffuse + end type ocnalb_type + + ! Conversion from degrees to radians + character(*),parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) + + !----------------------------------------------------------------------- + ! Initialize pointers to the module variables and then use the module + ! variables in the med_ocnalb phase + ! All input field bundles are ASSUMED to be on the ocean grid + !----------------------------------------------------------------------- + + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_Field, ESMF_Grid, ESMF_Mesh, ESMF_GeomType_Flag + use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_FieldGet, ESMF_GEOMTYPE_MESH + use ESMF , only : ESMF_MeshGet + use ESMF , only : operator(==) + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_GetFldPtr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFieldN + use shr_nuopc_utils_mod , only : shr_nuopc_utils_chkerr + use med_internalstate_mod , only : InternalState + use med_constants_mod , only : CL, R8 + use med_constants_mod , only : dbug_flag =>med_constants_dbug_flag + use esmFlds , only : compatm, compocn + use perf_mod , only : t_startf, t_stopf + ! Arguments + type(ESMF_GridComp) :: gcomp + type(ocnalb_type) , intent(inout) :: ocnalb + integer , intent(out) :: rc + ! + ! Local variables + type(ESMF_VM) :: vm + integer :: iam + type(ESMF_Field) :: lfield + type(ESMF_Mesh) :: lmesh + type(ESMF_GeomType_Flag) :: geomtype + integer :: n + integer :: lsize + integer :: dimCount + integer :: spatialDim + integer :: numOwnedElements + type(InternalState) :: is_local + real(R8), pointer :: ownedElemCoords(:) + character(len=CL) :: tempc1,tempc2 + integer :: dbrc + character(*), parameter :: subname = '(med_phases_ocnalb_init) ' + !----------------------------------------------------------------------- + call t_startf('MED:'//subname) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + ! The following is for debugging + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + ! Get the internal state from gcomp + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + !---------------------------------- + ! Set pointers to fields needed for albedo calculations + !---------------------------------- + + ! These must must be on the ocean grid since the ocean albedo computation is on the ocean grid + ! The following sets pointers to the module arrays + + call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, fldname='So_avsdr', fldptr1=ocnalb%avsdr, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, fldname='So_avsdf', fldptr1=ocnalb%avsdf, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, fldname='So_anidr', fldptr1=ocnalb%anidr, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, fldname='So_anidf', fldptr1=ocnalb%anidf, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + !---------------------------------- + ! Get lat, lon, which are time-invariant + !---------------------------------- + + ! The following assumes that all fields in FBMed_ocnalb_o have the same grid - so + ! only need to query field 1 + call shr_nuopc_methods_FB_getFieldN(is_local%wrap%FBMed_ocnalb_o, fieldnum=1, field=lfield, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + ! Determine if first field is on a grid or a mesh - default will be mesh + call ESMF_FieldGet(lfield, geomtype=geomtype, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + if (geomtype == ESMF_GEOMTYPE_MESH) then + call ESMF_LogWrite(trim(subname)//" : FBAtm is on a mesh ", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(lmesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + lsize = size(ocnalb%anidr) + if (numOwnedElements /= lsize) then + write(tempc1,'(i10)') numOwnedElements + write(tempc2,'(i10)') lsize + call ESMF_LogWrite(trim(subname)//": ERROR numOwnedElements "// trim(tempc1) // & + " not equal to local size "// trim(tempc2), ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + end if + allocate(ownedElemCoords(spatialDim*numOwnedElements)) + allocate(ocnalb%lons(numOwnedElements)) + allocate(ocnalb%lats(numOwnedElements)) + call ESMF_MeshGet(lmesh, ownedElemCoords=ownedElemCoords) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,lsize + ocnalb%lons(n) = ownedElemCoords(2*n-1) + ocnalb%lats(n) = ownedElemCoords(2*n) + end do + else + call ESMF_LogWrite(trim(subname)//": ERROR field bundle must be either on mesh", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + end if + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + call t_stopf('MED:'//subname) + + end subroutine med_phases_ocnalb_init + + !=============================================================================== + + subroutine med_phases_ocnalb_run(gcomp, rc) + + !----------------------------------------------------------------------- + ! Compute ocean albedos (on the ocean grid) + !----------------------------------------------------------------------- + + use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time, ESMF_TimeInterval + use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LogFoundError + use ESMF , only : ESMF_RouteHandleIsCreated + use ESMF , only : operator(+) + use NUOPC , only : NUOPC_CompAttributeGet + use shr_const_mod , only : shr_const_pi + use shr_sys_mod , only : shr_sys_abort + use shr_orb_mod , only : shr_orb_cosz, shr_orb_decl + use esmFlds , only : mapconsf, mapnames + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_GetFldPtr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_GetScalar + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FieldRegrid + use shr_nuopc_utils_mod , only : shr_nuopc_utils_chkerr + use med_constants_mod , only : CS, CL, R8 + use med_constants_mod , only : dbug_flag =>med_constants_dbug_flag + use med_internalstate_mod , only : InternalState, logunit + use shr_nuopc_scalars_mod , only : flds_scalar_name + use shr_nuopc_scalars_mod , only : flds_scalar_num + use shr_nuopc_scalars_mod , only : flds_scalar_index_nextsw_cday + use esmFlds , only : compatm, compocn + use perf_mod , only : t_startf, t_stopf + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ocnalb_type), save :: ocnalb + logical :: update_alb + type(InternalState) :: is_local + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currTime + type(ESMF_Time) :: nextTime + type(ESMF_TimeInterval) :: timeStep + character(CL) :: cvalue + character(CS) :: starttype ! config start type + character(CL) :: runtype ! initial, continue, hybrid, branch + character(CL) :: aoflux_grid + logical :: flux_albav ! flux avg option + real(R8) :: nextsw_cday ! calendar day of next atm shortwave + real(R8), pointer :: ofrac(:) + real(R8), pointer :: ofrad(:) + real(R8), pointer :: ifrac(:) + real(R8), pointer :: ifrad(:) + integer :: lsize ! local size + integer :: n,i ! indices + real(R8) :: rlat ! gridcell latitude in radians + real(R8) :: rlon ! gridcell longitude in radians + real(R8) :: cosz ! Cosine of solar zenith angle + real(R8) :: eccen ! Earth orbit eccentricity + real(R8) :: mvelpp ! Earth orbit + real(R8) :: lambm0 ! Earth orbit + real(R8) :: obliqr ! Earth orbit + real(R8) :: delta ! Solar declination angle in radians + real(R8) :: eccf ! Earth orbit eccentricity factor + real(R8), parameter :: albdif = 0.06_r8 ! 60 deg reference albedo, diffuse + real(R8), parameter :: albdir = 0.07_r8 ! 60 deg reference albedo, direct + real(R8), parameter :: const_deg2rad = shr_const_pi/180.0_R8 ! deg to rads + integer :: dbrc + logical :: first_call = .true. + character(len=*) , parameter :: subname='(med_phases_ocnalb_run)' + !--------------------------------------- + call t_startf('MED:'//subname) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + ! Get the internal state from Component. + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + ! Note that in the mct version the atm was initialized first so + ! that nextsw_cday could be passed to the other components - this + ! assumed that atmosphere component was ALWAYS initialized first. + ! In the nuopc version it will be easier to assume that on startup + ! - nextsw_cday is just what cam was setting it as the current calendar day + + if (first_call) then + + ! Initialize ocean albedo calculation + call med_phases_ocnalb_init(gcomp, ocnalb, rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp, name='start_type', value=cvalue, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) starttype + + if (trim(starttype) == trim('startup')) then + runtype = "initial" + else if (trim(starttype) == trim('continue') ) then + runtype = "continue" + else if (trim(starttype) == trim('branch')) then + runtype = "continue" + else + call shr_sys_abort( subname//' ERROR: unknown starttype' ) + end if + + call ESMF_GridCompGet(gcomp, clock=clock) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet( clock, currTime=currTime, timeStep=timeStep, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + if (trim(runtype) == 'initial') then + call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + else + call shr_nuopc_methods_State_GetScalar(is_local%wrap%NstateImp(compatm), & + flds_scalar_name=flds_scalar_name, flds_scalar_num=flds_scalar_num, & + scalar_id=flds_scalar_index_nextsw_cday, value=nextsw_cday, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + end if + + first_call = .false. + + else + + ! Note that shr_nuopc_methods_State_GetScalar includes a broadcast to all other pets + call shr_nuopc_methods_State_GetScalar(is_local%wrap%NstateImp(compatm), & + flds_scalar_name=flds_scalar_name, flds_scalar_num=flds_scalar_num, & + scalar_id=flds_scalar_index_nextsw_cday, value=nextsw_cday, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + end if + + call NUOPC_CompAttributeGet(gcomp, name='flux_albav', value=cvalue, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) flux_albav + + call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) eccen + call NUOPC_CompAttributeGet(gcomp, name='orb_obliqr', value=cvalue, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) obliqr + call NUOPC_CompAttributeGet(gcomp, name='orb_lambm0', value=cvalue, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) lambm0 + call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', value=cvalue, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) mvelpp + + ! Calculate ocean albedos on the ocean grid + + update_alb = .false. + lsize = size(ocnalb%anidr) + + if (flux_albav) then + do n = 1,lsize + ocnalb%anidr(n) = albdir + ocnalb%avsdr(n) = albdir + ocnalb%anidf(n) = albdif + ocnalb%avsdf(n) = albdif + end do + update_alb = .true. + else + ! Solar declination + ! Will only do albedo calculation if nextsw_cday is not -1. + if (nextsw_cday >= -0.5_r8) then + + call shr_orb_decl(nextsw_cday, eccen, mvelpp,lambm0, obliqr, delta, eccf) + + ! Compute albedos + do n = 1,lsize + rlat = const_deg2rad * ocnalb%lats(n) + rlon = const_deg2rad * ocnalb%lons(n) + cosz = shr_orb_cosz( nextsw_cday, rlat, rlon, delta ) + if (cosz > 0.0_r8) then !--- sun hit -- + ocnalb%anidr(n) = (.026_r8/(cosz**1.7_r8 + 0.065_r8)) + & + (.150_r8*(cosz - 0.100_r8 ) * & + (cosz - 0.500_r8 ) * (cosz - 1.000_r8 ) ) + ocnalb%avsdr(n) = ocnalb%anidr(n) + ocnalb%anidf(n) = albdif + ocnalb%avsdf(n) = albdif + else !--- dark side of earth --- + ocnalb%anidr(n) = 1.0_r8 + ocnalb%avsdr(n) = 1.0_r8 + ocnalb%anidf(n) = 1.0_r8 + ocnalb%avsdf(n) = 1.0_r8 + end if + end do + update_alb = .true. + + endif ! nextsw_cday + end if ! flux_albav + + ! Update current ifrad/ofrad values if albedo was updated in field bundle + if (update_alb) then + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compocn), fldname='ifrac', fldptr1=ifrac, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compocn), fldname='ifrad', fldptr1=ifrad, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compocn), fldname='ofrac', fldptr1=ofrac, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compocn), fldname='ofrad', fldptr1=ofrad, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + ifrad(:) = ifrac(:) + ofrad(:) = ofrac(:) + endif + + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBMed_ocnalb_o, string=trim(subname)//' FBMed_ocnalb_o', rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + end if + call t_stopf('MED:'//subname) + + end subroutine med_phases_ocnalb_run + + !=============================================================================== + + subroutine med_phases_ocnalb_mapo2a(gcomp, rc) + + !---------------------------------------------------------- + ! Map ocean albedos from ocn to atm grid + !---------------------------------------------------------- + + use ESMF , only : ESMF_GridComp + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use shr_nuopc_utils_mod , only : shr_nuopc_utils_chkerr + use med_map_mod , only : med_map_FB_Regrid_Norm + use med_internalstate_mod , only : InternalState + use med_constants_mod , only : R8 + use med_constants_mod , only : dbug_flag =>med_constants_dbug_flag + use esmFlds , only : fldListMed_ocnalb + use esmFlds , only : compatm, compocn + use perf_mod , only : t_startf, t_stopf + ! Arguments + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! Local variables + type(InternalState) :: is_local + integer :: dbrc + character(*), parameter :: subName = '(med_ocnalb_mapo2a) ' + !----------------------------------------------------------------------- + call t_startf('MED:'//subname) + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + ! Get the internal state from gcomp + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + ! Map the field bundle from the ocean to the atm grid + call med_map_FB_Regrid_Norm( & + fldListMed_ocnalb%flds, compocn, compatm, & + is_local%wrap%FBMed_ocnalb_o, & + is_local%wrap%FBMed_ocnalb_a, & + is_local%wrap%FBFrac(compocn), & + is_local%wrap%FBNormOne(compocn,compatm,:), & + is_local%wrap%RH(compocn,compatm,:), & + string='FBMed_ocnalb_o_To_FBMed_ocnalb_a', rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//subname) + + end subroutine med_phases_ocnalb_mapo2a + +end module med_phases_ocnalb_mod diff --git a/src/mediator/med_phases_prep_atm_mod.F90 b/src/mediator/med_phases_prep_atm_mod.F90 new file mode 100644 index 00000000..d645fd60 --- /dev/null +++ b/src/mediator/med_phases_prep_atm_mod.F90 @@ -0,0 +1,228 @@ +module med_phases_prep_atm_mod + + !----------------------------------------------------------------------------- + ! Mediator Phase + !----------------------------------------------------------------------------- + + implicit none + private + + public :: med_phases_prep_atm + + character(*) , parameter :: u_FILE_u = & + __FILE__ + +!----------------------------------------------------------------------------- +contains +!----------------------------------------------------------------------------- + + subroutine med_phases_prep_atm(gcomp, rc) + + ! Prepares the ATM import Fields. + + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FieldBundleGet, ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet + use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time, ESMF_ClockPrint + use med_constants_mod , only : R8 + use esmFlds , only : compatm, compocn, compice, ncomps, compname + use esmFlds , only : fldListFr, fldListTo + use esmFlds , only : fldListMed_aoflux + use esmFlds , only : coupling_mode + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_init + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_reset + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_GetFldPtr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FldChk + use shr_nuopc_utils_mod , only : shr_nuopc_memcheck + use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag + use med_merge_mod , only : med_merge_auto + use med_map_mod , only : med_map_FB_Regrid_Norm + use med_internalstate_mod , only : InternalState, mastertask + use med_phases_ocnalb_mod , only : med_phases_ocnalb_mapo2a + use perf_mod , only : t_startf, t_stopf + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_Time) :: time + character(len=64) :: timestr + type(InternalState) :: is_local + real(R8), pointer :: dataPtr1(:),dataPtr2(:) + integer :: i, j, n, n1, ncnt + logical,save :: first_call = .true. + integer :: dbrc + character(len=*),parameter :: subname='(med_phases_prep_atm)' + !------------------------------------------------------------------------------- + + call t_startf('MED:'//subname) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call shr_nuopc_memcheck(subname, 3, mastertask) + rc = ESMF_SUCCESS + + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + !--- Count the number of fields outside of scalar data, if zero, then return + !--------------------------------------- + + ! Note - the scalar field has been removed from all mediator field bundles - so this is why we check if the + ! fieldCount is 0 and not 1 here + + call ESMF_FieldBundleGet(is_local%wrap%FBExp(compatm), fieldCount=ncnt, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (ncnt == 0) then + call ESMF_LogWrite(trim(subname)//": only scalar data is present in FBexp(compatm), returning", & + ESMF_LOGMSG_INFO, rc=dbrc) + else + + !--------------------------------------- + !--- Get the current time from the clock + !--------------------------------------- + call ESMF_GridCompGet(gcomp, clock=clock) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(clock,currtime=time,rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(time,timestring=timestr) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": time = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug_flag > 1) then + if (mastertask) then + call ESMF_ClockPrint(clock, options="currTime", & + preString="-------->"//trim(subname)//" mediating for: ", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + + !--------------------------------------- + !--- map import field bundles from n1 grid to atm grid - FBimp(:,compatm) + !--------------------------------------- + do n1 = 1,ncomps + if (is_local%wrap%med_coupling_active(n1,compatm)) then + call med_map_FB_Regrid_Norm( & + fldListFr(n1)%flds, n1, compatm, & + is_local%wrap%FBImp(n1,n1), & + is_local%wrap%FBImp(n1,compatm), & + is_local%wrap%FBFrac(n1), & + is_local%wrap%FBNormOne(n1,compatm,:), & + is_local%wrap%RH(n1,compatm,:), & + string=trim(compname(n1))//'2'//trim(compname(compatm)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + enddo + + !--------------------------------------- + !--- map ocean albedos from ocn to atm grid if appropriate + !--------------------------------------- + if (trim(coupling_mode) == 'cesm') then + call med_phases_ocnalb_mapo2a(gcomp, rc) + end if + + !--------------------------------------- + !--- map atm/ocn fluxes from ocn to atm grid if appropriate + !--------------------------------------- + ! Assumption here is that fluxes are computed on the ocean grid + + if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'nems_orig') then + call med_map_FB_Regrid_Norm(& + fldListMed_aoflux%flds, compocn, compatm, & + is_local%wrap%FBMed_aoflux_o, & + is_local%wrap%FBMed_aoflux_a, & + is_local%wrap%FBFrac(compocn), & + is_local%wrap%FBNormOne(compocn,compatm,:), & + is_local%wrap%RH(compocn,compatm,:), & + string='FBMed_aoflux_o_To_FBMEd_aoflux_a', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + !--------------------------------------- + !--- merge all fields to atm + !--------------------------------------- + if (trim(coupling_mode) == 'cesm') then + call med_merge_auto(trim(compname(compatm)), & + is_local%wrap%FBExp(compatm), is_local%wrap%FBFrac(compatm), & + is_local%wrap%FBImp(:,compatm), fldListTo(compatm), & + FBMed1=is_local%wrap%FBMed_ocnalb_a, & + FBMed2=is_local%wrap%FBMed_aoflux_a, & + document=first_call, string='(merge_to_atm)', mastertask=mastertask, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else if (trim(coupling_mode) == 'nems_orig') then + call med_merge_auto(trim(compname(compatm)), & + is_local%wrap%FBExp(compatm), is_local%wrap%FBFrac(compatm), & + is_local%wrap%FBImp(:,compatm), fldListTo(compatm), & + FBMed1=is_local%wrap%FBMed_aoflux_a, & + document=first_call, string='(merge_to_atm)', mastertask=mastertask, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else if (trim(coupling_mode) == 'nems_frac') then + call med_merge_auto(trim(compname(compatm)), & + is_local%wrap%FBExp(compatm), is_local%wrap%FBFrac(compatm), & + is_local%wrap%FBImp(:,compatm), fldListTo(compatm), & + document=first_call, string='(merge_to_atm)', mastertask=mastertask, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compatm), string=trim(subname)//' FBexp(compatm) ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + !--- custom calculations + !--------------------------------------- + + ! set fractions to send back to atm + if (shr_nuopc_methods_FB_FldChk(is_local%wrap%FBExp(compatm), 'So_ofrac', rc=rc)) then + call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'So_ofrac', dataptr1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBFrac(compatm), 'ofrac', dataptr2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(dataptr1) + dataptr1(n) = dataptr2(n) + end do + end if + if (shr_nuopc_methods_FB_FldChk(is_local%wrap%FBExp(compatm), 'Si_ifrac', rc=rc)) then + call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Si_ifrac', dataptr1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBFrac(compatm), 'ifrac', dataptr2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(dataptr1) + dataptr1(n) = dataptr2(n) + end do + end if + if (shr_nuopc_methods_FB_FldChk(is_local%wrap%FBExp(compatm), 'Sl_lfrac', rc=rc)) then + call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Sl_lfrac', dataptr1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBFrac(compatm), 'lfrac', dataptr2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(dataptr1) + dataptr1(n) = dataptr2(n) + end do + end if + + !--------------------------------------- + !--- update local scalar data + !--------------------------------------- + + !is_local%wrap%scalar_data(1) = + + !--------------------------------------- + !--- clean up + !--------------------------------------- + + first_call = .false. + endif + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call t_stopf('MED:'//subname) + + end subroutine med_phases_prep_atm + +end module med_phases_prep_atm_mod diff --git a/src/mediator/med_phases_prep_glc_mod.F90 b/src/mediator/med_phases_prep_glc_mod.F90 new file mode 100644 index 00000000..524b87b6 --- /dev/null +++ b/src/mediator/med_phases_prep_glc_mod.F90 @@ -0,0 +1,151 @@ +module med_phases_prep_glc_mod + + !----------------------------------------------------------------------------- + ! Mediator Phases + !----------------------------------------------------------------------------- + + implicit none + private + + character(*) , parameter :: u_FILE_u = __FILE__ + + public :: med_phases_prep_glc + +!----------------------------------------------------------------------------- +contains +!----------------------------------------------------------------------------- + + subroutine med_phases_prep_glc(gcomp, rc) + use ESMF, only : ESMF_GridComp, ESMF_Clock, ESMF_Time + use ESMF, only: ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF, only: ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_ClockPrint + use ESMF, only: ESMF_FieldBundleGet + use esmFlds , only : compglc, ncomps, compname + use esmFlds , only : fldListFr, fldListTo + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag + use med_merge_mod , only : med_merge_auto + use med_map_mod , only : med_map_FB_Regrid_Norm + use med_internalstate_mod , only : InternalState, mastertask + use perf_mod , only : t_startf, t_stopf + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! Prepares the GLC import Fields. + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_Time) :: time + character(len=64) :: timestr + type(InternalState) :: is_local + integer :: i,j,n,n1,ncnt + logical,save :: first_call = .true. + character(len=*),parameter :: subname='(med_phases_prep_glc)' + integer :: dbrc + !--------------------------------------- + call t_startf('MED:'//subname) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + rc = ESMF_SUCCESS + + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + !--- Count the number of fields outside of scalar data, if zero, then return + !--------------------------------------- + + ! Note - the scalar field has been removed from all mediator field bundles - so this is why we check if the + ! fieldCount is 0 and not 1 here + + call ESMF_FieldBundleGet(is_local%wrap%FBExp(compglc), fieldCount=ncnt, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (ncnt == 0) then + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": only scalar data is present in FBexp(compglc), returning", & + ESMF_LOGMSG_INFO, rc=dbrc) + endif + else + + !--------------------------------------- + !--- Get the current time from the clock + !--------------------------------------- + + call ESMF_GridCompGet(gcomp, clock=clock) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(clock,currtime=time,rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(time,timestring=timestr) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": time = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) + endif + + if (mastertask) then + call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//" mediating for: ", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + !--------------------------------------- + !--- mapping + !--------------------------------------- + + do n1 = 1,ncomps + if (is_local%wrap%med_coupling_active(n1,compglc)) then + call med_map_FB_Regrid_Norm( & + fldListFr(n1)%flds, n1, compglc, & + is_local%wrap%FBImp(n1,n1), & + is_local%wrap%FBImp(n1,compglc), & + is_local%wrap%FBFrac(n1), & + is_local%wrap%FBNormOne(n1,compglc,:), & + is_local%wrap%RH(n1,compglc,:), & + string=trim(compname(n1))//'2'//trim(compname(compglc)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + enddo + + !--------------------------------------- + !--- auto merges + !--------------------------------------- + + call med_merge_auto(trim(compname(compglc)), & + is_local%wrap%FBExp(compglc), is_local%wrap%FBFrac(compglc), & + is_local%wrap%FBImp(:,compglc), fldListTo(compglc), & + document=first_call, string='(merge_to_lnd)', mastertask=mastertask, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compglc), string=trim(subname)//' FBexp(compglc) ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + !--------------------------------------- + !--- custom calculations + !--------------------------------------- + + !--------------------------------------- + !--- update local scalar data + !--------------------------------------- + + !is_local%wrap%scalar_data(1) = + + !--------------------------------------- + !--- clean up + !--------------------------------------- + + first_call = .false. + endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call t_stopf('MED:'//subname) + + end subroutine med_phases_prep_glc + +end module med_phases_prep_glc_mod diff --git a/src/mediator/med_phases_prep_ice_mod.F90 b/src/mediator/med_phases_prep_ice_mod.F90 new file mode 100644 index 00000000..95a4f0fe --- /dev/null +++ b/src/mediator/med_phases_prep_ice_mod.F90 @@ -0,0 +1,255 @@ +module med_phases_prep_ice_mod + + !----------------------------------------------------------------------------- + ! Mediator Phases + !----------------------------------------------------------------------------- + + implicit none + private + + character(*) , parameter :: u_FILE_u = __FILE__ + + public :: med_phases_prep_ice + +!----------------------------------------------------------------------------- + contains +!----------------------------------------------------------------------------- + + subroutine med_phases_prep_ice(gcomp, rc) + + ! Prepares the ICE import Fields. + + use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_ClockPrint + use ESMF , only : ESMF_FieldBundleGet, ESMF_RouteHandleIsCreated + use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE + use NUOPC , only : NUOPC_IsConnected + use med_constants_mod , only : CL, CS, R8 + use esmFlds , only : compatm, compice, comprof, compglc, ncomps, compname + use esmFlds , only : fldListFr, fldListTo + use esmFlds , only : mapbilnr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_reset + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_GetFldPtr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FldChk + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FieldRegrid + use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag + use med_merge_mod , only : med_merge_auto + use med_map_mod , only : med_map_FB_Regrid_Norm + use med_internalstate_mod , only : InternalState, logunit, mastertask + use perf_mod , only : t_startf, t_stopf + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_Time) :: time + character(len=64) :: timestr + type(InternalState) :: is_local + real(R8), pointer :: dataPtr1(:) + integer :: i,n,n1,ncnt + character(len=CS) :: fldname + real(R8), pointer :: dataptr(:) + real(R8), pointer :: temperature(:) + real(R8), pointer :: pressure(:) + real(R8), pointer :: humidity(:) + real(R8), pointer :: air_density(:) + real(R8), pointer :: pot_temp(:) + character(len=1024) :: msgString + ! TODO: the calculation needs to be set at run time based on receiving it from the ocean + real(R8) :: flux_epbalfact = 1._R8 + logical,save :: first_call = .true. + integer :: dbrc + character(len=*),parameter :: subname='(med_phases_prep_ice)' + !--------------------------------------- + + call t_startf('MED:'//subname) + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + !--- Count the number of fields outside of scalar data, if zero, then return + !--------------------------------------- + + ! Note - the scalar field has been removed from all mediator field bundles - so this is why we check if the + ! fieldCount is 0 and not 1 here + + call ESMF_FieldBundleGet(is_local%wrap%FBExp(compice), fieldCount=ncnt, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ncnt == 0) then + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": only scalar data is present in FBexp(compice), returning", & + ESMF_LOGMSG_INFO, rc=dbrc) + endif + RETURN + end if + + !--------------------------------------- + !--- Get the current time from the clock + !--------------------------------------- + + call ESMF_GridCompGet(gcomp, clock=clock) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(clock,currtime=time,rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(time,timestring=timestr) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": time = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) + + !--------------------------------------- + !--- map to create FBimp(:,compice) + !--------------------------------------- + + do n1 = 1,ncomps + if (is_local%wrap%med_coupling_active(n1,compice)) then + call med_map_FB_Regrid_Norm( & + fldListFr(n1)%flds, n1, compice, & + is_local%wrap%FBImp(n1,n1), & + is_local%wrap%FBImp(n1,compice), & + is_local%wrap%FBFrac(n1), & + is_local%wrap%FBNormOne(n1,compice,:), & + is_local%wrap%RH(n1,compice,:), & + string=trim(compname(n1))//'2'//trim(compname(compice)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + enddo + + !--------------------------------------- + !--- auto merges + !--------------------------------------- + + call med_merge_auto(trim(compname(compice)), & + is_local%wrap%FBExp(compice), is_local%wrap%FBFrac(compice), & + is_local%wrap%FBImp(:,compice), fldListTo(compice), & + document=first_call, string='(merge_to_ice)', mastertask=mastertask, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + !--- custom calculations + !--------------------------------------- + + ! If either air density or ptem from atm is not available - then need to remp pbot since it will be + ! required for either calculation + if ( .not. shr_nuopc_methods_FB_FldChk(is_local%wrap%FBImp(compatm,compatm), 'Sa_dens',rc=rc) .or. & + .not. shr_nuopc_methods_FB_FldChk(is_local%wrap%FBImp(compatm,compatm), 'Sa_ptem',rc=rc)) then + + ! Determine Sa_pbot on the ice grid and get a pointer to it + if (.not. shr_nuopc_methods_FB_FldChk(is_local%wrap%FBExp(compice), 'Sa_pbot',rc=rc)) then + if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(compatm,compice,mapbilnr))) then + call ESMF_LogWrite(trim(subname)//": ERROR bilinr RH not available for atm->ice", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + end if + call shr_nuopc_methods_FB_FieldRegrid( & + is_local%wrap%FBImp(compatm,compatm), 'Sa_pbot', & + is_local%wrap%FBImp(compatm,compice), 'Sa_pbot', & + is_local%wrap%RH(compatm,compice,mapbilnr), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBImp(compatm,compice), 'Sa_pbot', pressure, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Get a pointer to Sa_tbot on the ice grid + call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBImp(compatm,compice), 'Sa_tbot', temperature, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! compute air density as a custom calculation + if ( .not. shr_nuopc_methods_FB_FldChk(is_local%wrap%FBImp(compatm,compatm), 'Sa_dens',rc=rc)) then + call ESMF_LogWrite(trim(subname)//": computing air density as a custom calculation", ESMF_LOGMSG_INFO, rc=dbrc) + + call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBImp(compatm,compice), 'Sa_shum', humidity, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBExp(compice), 'Sa_dens', air_density, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1,size(temperature) + if (temperature(n) /= 0._R8) then + air_density(n) = pressure(n) / (287.058_R8*(1._R8 + 0.608_R8*humidity(n))*temperature(n)) + else + air_density(n) = 0._R8 + endif + end do + end if + + ! compute potential temperature as a custom calculation + if (.not. shr_nuopc_methods_FB_FldChk(is_local%wrap%FBImp(compatm,compatm), 'Sa_ptem',rc=rc)) then + call ESMF_LogWrite(trim(subname)//": computing potential temp as a custom calculation", ESMF_LOGMSG_INFO, rc=dbrc) + + call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBExp(compice), 'Sa_ptem', pot_temp, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1,size(temperature) + if (pressure(n) /= 0._R8) then + pot_temp(n) = temperature(n) * (100000._R8/pressure(n))**0.286_R8 ! Potential temperature (K) + else + pot_temp(n) = 0._R8 + end if + end do + end if + + ! scale rain, snow and rof to ice by flux_epbalfact + if (shr_nuopc_methods_FB_FldChk(is_local%wrap%FBExp(compice), 'Faxa_rain', rc=rc)) then + call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBExp(compice), 'Faxa_rain' , dataptr1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + dataptr1(:) = dataptr1(:) * flux_epbalfact + if (first_call .and. mastertask) then + write(logunit,'(a)')'(merge_to_ice): Scaling Faxa_rain by flux_epbalfact ' + end if + end if + if (shr_nuopc_methods_FB_FldChk(is_local%wrap%FBExp(compice), 'Faxa_snow', rc=rc)) then + call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBExp(compice), 'Faxa_snow' , dataptr1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + dataptr1(:) = dataptr1(:) * flux_epbalfact + if (first_call .and. mastertask) then + write(logunit,'(a)')'(merge_to_ice): Scaling Faxa_snow by flux_epbalfact ' + end if + end if + if (shr_nuopc_methods_FB_FldChk(is_local%wrap%FBExp(compice), 'Fixx_rofi', rc=rc)) then + call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBExp(compice), 'Fixx_rofi' , dataptr1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + dataptr1(:) = dataptr1(:) * flux_epbalfact + if (first_call .and. mastertask) then + write(logunit,'(a)')'(merge_to_ice): Scaling Fixx_rofi by flux_epbalfact ' + end if + end if + + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compice), string=trim(subname)//' FBexp(compice) ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + !--- update local scalar data + !--------------------------------------- + + !is_local%wrap%scalar_data(1) = + + !--------------------------------------- + !--- clean up + !--------------------------------------- + + first_call = .false. + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + call t_stopf('MED:'//subname) + + end subroutine med_phases_prep_ice + +end module med_phases_prep_ice_mod diff --git a/src/mediator/med_phases_prep_lnd_mod.F90 b/src/mediator/med_phases_prep_lnd_mod.F90 new file mode 100644 index 00000000..a69fbf25 --- /dev/null +++ b/src/mediator/med_phases_prep_lnd_mod.F90 @@ -0,0 +1,151 @@ +module med_phases_prep_lnd_mod + + !----------------------------------------------------------------------------- + ! Mediator Phases + !----------------------------------------------------------------------------- + + implicit none + private + + character(*) , parameter :: u_FILE_u = & + __FILE__ + + public :: med_phases_prep_lnd + +!----------------------------------------------------------------------------- +contains +!----------------------------------------------------------------------------- + + subroutine med_phases_prep_lnd(gcomp, rc) + + ! Prepares the LND import Fields. + + use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_ClockPrint + use ESMF , only : ESMF_FieldBundleGet + use med_constants_mod , only : CL, CS, CX + use esmFlds , only : complnd, ncomps, compname, comprof + use esmFlds , only : fldListFr, fldListTo + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_init + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag + use med_merge_mod , only : med_merge_auto + use med_map_mod , only : med_map_FB_Regrid_Norm + use med_internalstate_mod , only : InternalState, mastertask + use perf_mod , only : t_startf, t_stopf + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_Time) :: time + character(len=64) :: timestr + type(InternalState) :: is_local + integer :: i,j,n,n1,nf,compsrc + integer :: ncnt + integer :: dbrc + logical,save :: first_call = .true. + character(len=*),parameter :: subname='(med_phases_prep_lnd)' + !--------------------------------------- + call t_startf('MED:'//subname) + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + rc = ESMF_SUCCESS + + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + !--- Count the number of fields outside of scalar data, if zero, then return + !--------------------------------------- + + ! Note - the scalar field has been removed from all mediator field bundles - so this is why we check if the + ! fieldCount is 0 and not 1 here + + call ESMF_FieldBundleGet(is_local%wrap%FBExp(complnd), fieldCount=ncnt, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (ncnt == 0) then + call ESMF_LogWrite(trim(subname)//": only scalar data is present in FBexp(complnd), returning", & + ESMF_LOGMSG_INFO, rc=dbrc) + else + + !--------------------------------------- + !--- Get the current time from the clock + !--------------------------------------- + + if (mastertask) then + call ESMF_GridCompGet(gcomp, clock=clock) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(clock,currtime=time,rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(time,timestring=timestr) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": time = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//" mediating for: ", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + !--------------------------------------- + !--- Map import fields to the complnd grid + !--------------------------------------- + + do n1 = 1,ncomps + if (is_local%wrap%med_coupling_active(n1,complnd)) then + call med_map_FB_Regrid_Norm( & + fldListFr(n1)%flds, n1, complnd, & + is_local%wrap%FBImp(n1,n1), & + is_local%wrap%FBImp(n1,complnd), & + is_local%wrap%FBFrac(n1), & + is_local%wrap%FBNormOne(n1,complnd,:), & + is_local%wrap%RH(n1,complnd,:), & + string=trim(compname(n1))//'2'//trim(compname(complnd)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + enddo + + !--------------------------------------- + !--- Merge all required import fields on the complnd grid to create FBExp + !--------------------------------------- + + call med_merge_auto(trim(compname(complnd)), & + is_local%wrap%FBExp(complnd), is_local%wrap%FBFrac(complnd), & + is_local%wrap%FBImp(:,complnd), fldListTo(complnd), & + document=first_call, string='(merge_to_lnd)', mastertask=mastertask, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(complnd), string=trim(subname)//' FBexp(complnd) ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + !--- custom calculations + !--------------------------------------- + + !--------------------------------------- + !--- update local scalar data + !--------------------------------------- + + !is_local%wrap%scalar_data(1) = + + !--------------------------------------- + !--- clean up + !--------------------------------------- + + first_call = .false. + end if + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call t_stopf('MED:'//subname) + + end subroutine med_phases_prep_lnd + +end module med_phases_prep_lnd_mod diff --git a/src/mediator/med_phases_prep_ocn_mod.F90 b/src/mediator/med_phases_prep_ocn_mod.F90 new file mode 100644 index 00000000..727ef1b6 --- /dev/null +++ b/src/mediator/med_phases_prep_ocn_mod.F90 @@ -0,0 +1,707 @@ +module med_phases_prep_ocn_mod + + use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag + use shr_nuopc_utils_mod , only : shr_nuopc_memcheck + use med_internalstate_mod , only : mastertask + + !----------------------------------------------------------------------------- + ! Carry out fast accumulation for the ocean + !----------------------------------------------------------------------------- + + implicit none + private + + public :: med_phases_prep_ocn_map + public :: med_phases_prep_ocn_merge + public :: med_phases_prep_ocn_accum_fast + public :: med_phases_prep_ocn_accum_avg + + character(*), parameter :: u_FILE_u = & + __FILE__ + +!----------------------------------------------------------------------------- +contains +!----------------------------------------------------------------------------- + + subroutine med_phases_prep_ocn_map(gcomp, rc) + + !--------------------------------------- + ! Map all fields in from relevant source components to the ocean grid + !--------------------------------------- + + use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO,ESMF_SUCCESS + use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_ClockPrint + use ESMF , only : ESMF_FieldBundleGet + use med_internalstate_mod , only : InternalState + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNumFlds + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use med_map_mod , only : med_map_FB_Regrid_Norm + use esmFlds , only : fldListFr + use esmFlds , only : compocn, ncomps, compname + use perf_mod , only : t_startf, t_stopf + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: n1, ncnt + integer :: dbrc + character(len=*), parameter :: subname='(med_phases_prep_ocn_map)' + !------------------------------------------------------------------------------- + + call t_startf('MED:'//subname) + if (dbug_flag > 20) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + end if + rc = ESMF_SUCCESS + call shr_nuopc_memcheck(subname, 5, mastertask) + + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + ! --- Count the number of fields outside of scalar data, if zero, then return + !--------------------------------------- + call shr_nuopc_methods_FB_getNumFlds(is_local%wrap%FBExp(compocn), trim(subname)//"FBexp(compocn)", ncnt, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (ncnt > 0) then + + !--------------------------------------- + !--- map all fields in FBImp that have active ocean coupling to the ocean grid + !--------------------------------------- + + do n1 = 1,ncomps + if (is_local%wrap%med_coupling_active(n1,compocn)) then + call med_map_FB_Regrid_Norm( & + fldListFr(n1)%flds, n1, compocn, & + is_local%wrap%FBImp(n1,n1), & + is_local%wrap%FBImp(n1,compocn), & + is_local%wrap%FBFrac(n1), & + is_local%wrap%FBNormOne(n1,compocn,:), & + is_local%wrap%RH(n1,compocn,:), & + string=trim(compname(n1))//'2'//trim(compname(compocn)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + enddo + endif + + call t_stopf('MED:'//subname) + if (dbug_flag > 20) then + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + end if + + end subroutine med_phases_prep_ocn_map + + !----------------------------------------------------------------------------- + + subroutine med_phases_prep_ocn_merge(gcomp, rc) + + use ESMF , only : ESMF_GridComp, ESMF_FieldBundleGet + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_methods_mod , only : fldchk => shr_nuopc_methods_FB_FldChk + use shr_nuopc_methods_mod , only : FB_GetFldPtr => shr_nuopc_methods_FB_GetFldPtr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNumFlds + use med_constants_mod , only : R8 + use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_merge_mod , only : med_merge_auto, med_merge_field + use esmFlds , only : fldListTo + use esmFlds , only : compocn, compname, compatm, compice + use esmFlds , only : coupling_mode + use perf_mod , only : t_startf, t_stopf + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: n, ncnt + real(R8) :: c1,c2,c3,c4 + real(R8), pointer :: dataptr(:) + real(R8), pointer :: ifrac(:), ofrac(:) + real(R8), pointer :: ifracr(:), ofracr(:) + real(R8), pointer :: avsdr(:), avsdf(:) + real(R8), pointer :: anidr(:), anidf(:) + real(R8), pointer :: Faxa_swvdf(:), Faxa_swndf(:) + real(R8), pointer :: Faxa_swvdr(:), Faxa_swndr(:) + real(R8), pointer :: Foxx_swnet(:) + real(R8), pointer :: Foxx_swnet_vdr(:), Foxx_swnet_vdf(:) + real(R8), pointer :: Foxx_swnet_idr(:), Foxx_swnet_idf(:) + real(R8), pointer :: Fioi_swpen_vdr(:), Fioi_swpen_vdf(:) + real(R8), pointer :: Fioi_swpen_idr(:), Fioi_swpen_idf(:) + real(R8), pointer :: Fioi_swpen(:) + real(R8), pointer :: Foxx_evap(:) + real(R8), pointer :: Foxx_lwnet(:) + real(R8), pointer :: Faox_lwup(:) + real(R8), pointer :: Faxa_lwdn(:) + real(R8) :: ifrac_scaled, ofrac_scaled + real(R8) :: ifracr_scaled, ofracr_scaled + real(R8) :: frac_sum + real(R8) :: albvis_dir, albvis_dif + real(R8) :: albnir_dir, albnir_dif + real(R8) :: fswabsv, fswabsi + real(R8) :: flux_epbalfact + logical :: export_swnet_by_bands + logical :: import_swpen_by_bands + logical :: first_call = .true. + integer :: lsize + integer :: dbrc + ! NEMS-orig + real(R8), pointer :: ocnwgt1(:) + real(R8), pointer :: icewgt1(:) + real(R8), pointer :: wgtp01(:) + real(R8), pointer :: wgtm01(:) + real(R8), pointer :: customwgt(:) + ! + character(len=64), allocatable :: fldnames(:) + real(R8) , parameter :: const_lhvap = 2.501e6_R8 ! latent heat of evaporation ~ J/kg + real(R8) , parameter :: albdif = 0.06_r8 ! 60 deg reference albedo, diffuse + character(len=*), parameter :: subname='(med_phases_prep_ocn_merge)' + !--------------------------------------- + + call t_startf('MED:'//subname) + if (dbug_flag > 20) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + end if + rc = ESMF_SUCCESS + call shr_nuopc_memcheck(subname, 5, mastertask) + + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + ! --- Count the number of fields outside of scalar data, if zero, then return + !--------------------------------------- + + call shr_nuopc_methods_FB_getNumFlds(is_local%wrap%FBExp(compocn), trim(subname)//"FBexp(compocn)", ncnt, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (ncnt >= 0) then + + !--------------------------------------- + !--- auto merges to ocn + !--------------------------------------- + + if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'nems_orig') then + call med_merge_auto(trim(compname(compocn)), & + is_local%wrap%FBExp(compocn), is_local%wrap%FBFrac(compocn), & + is_local%wrap%FBImp(:,compocn), fldListTo(compocn), & + FBMed1=is_local%wrap%FBMed_aoflux_o, & + document=first_call, string='(merge_to_ocn)', mastertask=mastertask, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else if (trim(coupling_mode) == 'nems_frac') then + call med_merge_auto(trim(compname(compocn)), & + is_local%wrap%FBExp(compocn), is_local%wrap%FBFrac(compocn), & + is_local%wrap%FBImp(:,compocn), fldListTo(compocn), & + document=first_call, string='(merge_to_ocn)', mastertask=mastertask, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + !--------------------------------------- + !--- custom calculations + !--------------------------------------- + + !------------- + ! Compute netsw for ocean + !------------- + + ! netsw_for_ocn = downsw_from_atm * (1-ocn_albedo) * (1-ice_fraction) + pensw_from_ice * (ice_fraction) + + ! Input from atm + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swvdr', Faxa_swvdr, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swndr', Faxa_swndr, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swvdf', Faxa_swvdf, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swndf', Faxa_swndf, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + lsize = size(Faxa_swvdr) + + ! Input from mediator, ice-covered ocean and open ocean fractions + call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrac' , ifrac, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac' , ofrac, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Input from mediator, ocean albedos + if (trim(coupling_mode) == 'cesm') then + call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_avsdr' , avsdr, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_anidr' , anidr, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_avsdf' , avsdf, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_anidf' , anidf, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrad' , ifracr, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrad' , ofracr, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Input from ice + if (is_local%wrap%comp_present(compice)) then + call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen', Fioi_swpen, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdr', rc=rc)) then + import_swpen_by_bands = .true. + call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_vdr', Fioi_swpen_vdr, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_vdf', Fioi_swpen_vdf, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_idr', Fioi_swpen_idr, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_idf', Fioi_swpen_idf, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else + import_swpen_by_bands = .false. + end if + end if + + ! Output to ocean + if (fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet', Foxx_swnet, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else + lsize = size(Faxa_swvdr) + allocate(Foxx_swnet(lsize)) + end if + if (fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc)) then + export_swnet_by_bands = .true. + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', Foxx_swnet_vdr, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', Foxx_swnet_vdf, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', Foxx_swnet_idr, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', Foxx_swnet_idf, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else + export_swnet_by_bands = .false. + end if + + do n = 1,lsize + + ! Determine ocean albedos + if (trim(coupling_mode) == 'cesm') then + albvis_dir = avsdr(n) + albvis_dif = avsdf(n) + albnir_dir = anidr(n) + albnir_dif = anidf(n) + else + albvis_dir = albdif + albvis_dif = albdif + albnir_dir = albdif + albnir_dif = albdif + end if + + ! Compute total swnet to ocean independent of swpen from sea-ice + fswabsv = Faxa_swvdr(n) * (1.0_R8 - albvis_dir) + Faxa_swvdf(n) * (1.0_R8 - albvis_dif) + fswabsi = Faxa_swndr(n) * (1.0_R8 - albnir_dir) + Faxa_swndf(n) * (1.0_R8 - albnir_dif) + Foxx_swnet(n) = fswabsv + fswabsi + + ! Add swpen from sea ice if sea ice is present + if (is_local%wrap%comp_present(compice)) then + if (trim(coupling_mode) == 'cesm') then + ifrac_scaled = ifrac(n) + ofrac_scaled = ofrac(n) + frac_sum = ifrac(n) + ofrac(n) + if (frac_sum /= 0._R8) then + ifrac_scaled = ifrac(n) / (frac_sum) + ofrac_scaled = ofrac(n) / (frac_sum) + endif + ifracr_scaled = ifracr(n) + ofracr_scaled = ofracr(n) + frac_sum = ifracr(n) + ofracr(n) + if (frac_sum /= 0._R8) then + ifracr_scaled = ifracr(n) / (frac_sum) + ofracr_scaled = ofracr(n) / (frac_sum) + endif + else + ofracr_scaled = ofrac(n) + ifrac_scaled = ifrac(n) + end if + Foxx_swnet(n) = ofracr_scaled*Foxx_swnet(n) + ifrac_scaled*Fioi_swpen(n) + + if (export_swnet_by_bands) then + if (import_swpen_by_bands) then + ! use each individual band for swpen coming from the sea-ice + Foxx_swnet_vdr(n) = Faxa_swvdr(n)*(1.0_R8-albvis_dir)*ofracr_scaled + Fioi_swpen_vdr(n)*ifrac_scaled + Foxx_swnet_vdf(n) = Faxa_swvdf(n)*(1.0_R8-albvis_dif)*ofracr_scaled + Fioi_swpen_vdf(n)*ifrac_scaled + Foxx_swnet_idr(n) = Faxa_swndr(n)*(1.0_R8-albnir_dir)*ofracr_scaled + Fioi_swpen_idr(n)*ifrac_scaled + Foxx_swnet_idf(n) = Faxa_swndf(n)*(1.0_R8-albnir_dif)*ofracr_scaled + Fioi_swpen_idf(n)*ifrac_scaled + else + ! scale total Foxx_swnet to get contributions from each band + c1 = 0.285 + c2 = 0.285 + c3 = 0.215 + c4 = 0.215 + Foxx_swnet_vdr(n) = c1 * Foxx_swnet(n) + Foxx_swnet_vdf(n) = c2 * Foxx_swnet(n) + Foxx_swnet_idr(n) = c3 * Foxx_swnet(n) + Foxx_swnet_idf(n) = c4 * Foxx_swnet(n) + end if + end if + ! TODO (mvertens, 2018-12-16): fill in the following + ! if (i2o_per_cat) then + ! Sf_ofrac(n) = ofrac(n) + ! Sf_ofracr(n) = ofracr(n) + ! Foxx_swnet_ofracr(n) = (fswabsv + fswabsi) * ofracr_scaled + ! end if + end if ! if sea-ice is present + end do + + !------------- + ! custom calculation for cesm coupling + !------------- + if (trim(coupling_mode) == 'cesm') then + + ! scale precipitation and runoff by epbalfact + ! TODO (mvertens, 2018-12-16): the calculation needs to be set + ! at run time based on receiving it from the ocean + flux_epbalfact = 1.0_r8 + + allocate(fldnames(5)) + fldnames = (/'Foxx_rain',' Foxx_snow', 'Foxx_prec', 'Foxx_rofl', 'Foxx_rofi'/) + do n = 1,size(fldnames) + if (fldchk(is_local%wrap%FBExp(compocn), trim(fldnames(n)), rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), trim(fldnames(n)) , dataptr, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + dataptr(:) = dataptr(:) * flux_epbalfact + if (first_call .and. mastertask) then + write(logunit,'(a)')'(merge_to_ocn): Scaling '//trim(fldnames(n))//' by flux_epbalfact ' + end if + end if + end do + deallocate(fldnames) + end if + + !------------- + ! custom calculation for nems_frac coupling + !------------- + if (trim(coupling_mode) == 'nems_frac') then + + ! determine evaporation to send to ocean + ! Note - don't need to scale the calculated evap by ofrac - since the merged latent heat + ! to the ocean has already had this scaling done + ! TODO (mvertens, 2018-12-16): is this the right sign below? Minus here is based on nems mediator + + allocate(customwgt(lsize)) + customwgt(:) = - 1._r8 / const_lhvap + call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_evap', & + FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_lat', wgtA=customwgt, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(customwgt) + end if + + !------------- + ! Custom calculation for nems_orig coupling + !------------- + if (trim(coupling_mode) == 'nems_orig') then + + ! open ocean (i.e. atm) and ice fraction + ! ocnwgt and icewgt are the "normal" fractions + ! ocnwgt1, icewgt1, and wgtp01 are the fractions that switch between atm and mediator fluxes + ! wgtp01 and wgtm01 are the same just one is +1 and the other is -1 to change sign depending on the ice fraction. + ! ocnwgt1+icewgt1+wgtp01 = 1.0 always + ! wgtp01 = 1 and wgtm01 = -1 when ice fraction = 0 + ! wgtp01 = 0 and wgtm01 = 0 when ice fraction > 0 + + allocate(ocnwgt1(lsize)) + allocate(icewgt1(lsize)) + allocate(wgtp01(lsize)) + allocate(wgtm01(lsize)) + allocate(customwgt(lsize)) + + do n = 1,lsize + if (ifrac(n) <= 0._R8) then + ! ice fraction is 0 + ocnwgt1(n) = 0.0_R8 + icewgt1(n) = 0.0_R8 + wgtp01(n) = 1.0_R8 + wgtm01(n) = -1.0_R8 + else + ! ice fraction is > 0 + ocnwgt1(n) = ofrac(n) + icewgt1(n) = ifrac(n) + wgtp01(n) = 0.0_R8 + wgtm01(n) = 0.0_R8 + end if + + ! check wgts do add to 1 as expected + if ( abs( ofrac(n) + ifrac(n) - 1.0_R8) > 1.0e-12 .or. & + abs( ocnwgt1(n) + icewgt1(n) + wgtp01(n) - 1.0_R8) > 1.0e-12 .or. & + abs( ocnwgt1(n) + icewgt1(n) - wgtm01(n) - 1.0_R8) > 1.0e-12) then + + write(6,100)trim(subname)//'ERROR: n, ofrac, ifrac, sum',& + n,ofrac(n),ifrac(n),ofrac(n)+ifrac(n) + write(6,101)trim(subname)//'ERROR: n, ocnwgt1, icewgt1, wgtp01, sum ', & + n,ocnwgt1(n),icewgt1(n),wgtp01(n),ocnwgt1(n)+icewgt1(n)+wgtp01(n) + write(6,101)trim(subname)//'ERROR: n, ocnwgt1, icewgt1, -wgtm01, sum ', & + n,ocnwgt1(n),icewgt1(n),-wgtp01(n),ocnwgt1(n)+icewgt1(n)-wgtm01(n) +100 format(a,i8,2x,3(d20.13,2x)) +101 format(a,i8,2x,4(d20.13,2x)) + + call ESMF_LogWrite(trim(subname)//": ERROR atm + ice fracs inconsistent", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) + rc = ESMF_FAILURE + return + endif + end do + + customwgt(:) = wgtm01(:) / const_lhvap + ! mean_evap_rate = mean_laten_heat_flux * (1-ice_fraction)/const_lhvap + call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_evap', & + FBinA=is_local%wrap%FBMed_aoflux_o , fnameA='Faox_evap', wgtA=ocnwgt1, & + FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_lat' , wgtB=customwgt, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_sen', & + FBinA=is_local%wrap%FBMed_aoflux_o , fnameA='Faox_sen ' , wgtA=ocnwgt1, & + FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_melth' , wgtB=icewgt1, & + FBinC=is_local%wrap%FBImp(compatm,compocn), fnameC='Faxa_sen' , wgtc=wgtm01, rc=rc) + + call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_taux', & + FBinA=is_local%wrap%FBMed_aoflux_o , fnameA='Faox_taux ', wgtA=ocnwgt1, & + FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_taux' , wgtB=icewgt1, & + FBinC=is_local%wrap%FBImp(compatm,compocn), fnameC='Faxa_taux' , wgtc=wgtm01, rc=rc) + + call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_tauy', & + FBinA=is_local%wrap%FBMed_aoflux_o , fnameA='Faox_tauy ', wgtA=ocnwgt1, & + FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_tauy' , wgtB=icewgt1, & + FBinC=is_local%wrap%FBImp(compatm,compocn), fnameC='Faxa_tauy' , wgtc=wgtm01, rc=rc) + + ! If there is no ice on the ocn gridcell (ocnwgt1=0) - sum Faxa_lwdn and Faxa_lwup + ! If there is ice on the ocn gridcell - merge Faox_lwup and Faxa_lwdn and ignore Faxa_lwup + call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_lwnet' , & + FBinA=is_local%wrap%FBMed_aoflux_o , fnameA='Faox_lwup ' , wgtA=ocnwgt1, & + FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_lwdn' , wgtB=ocnwgt1, & + FBinC=is_local%wrap%FBImp(compatm,compocn), fnameC='Faxa_lwnet' , wgtc=wgtp01, rc=rc) + + deallocate(ocnwgt1) + deallocate(icewgt1) + deallocate(wgtp01) + deallocate(wgtm01) + deallocate(customwgt) + + end if ! end of NEMS-orig ocn prep phase + + !--------------------------------------- + !--- diagnose output + !--------------------------------------- + + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compocn), string=trim(subname)//' FBexp(compocn) ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! TODO (mvertens, 2018-12-16): document above custom calculation + + !--------------------------------------- + !--- clean up + !--------------------------------------- + + first_call = .false. + endif + + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + end if + call t_stopf('MED:'//subname) + + end subroutine med_phases_prep_ocn_merge + + !----------------------------------------------------------------------------- + + subroutine med_phases_prep_ocn_accum_fast(gcomp, rc) + + ! Carry out fast accumulation for the ocean + + use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_ClockPrint + use ESMF , only : ESMF_FieldBundleGet + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_accum + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNumFlds + use med_internalstate_mod , only : InternalState, mastertask + use esmFlds , only : compocn + use perf_mod , only : t_startf, t_stopf + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_Time) :: time + character(len=64) :: timestr + type(InternalState) :: is_local + integer :: i,j,n,ncnt + integer :: dbrc + character(len=*), parameter :: subname='(med_phases_accum_fast)' + !--------------------------------------- + call t_startf('MED:'//subname) + + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + ! --- Count the number of fields outside of scalar data, if zero, then return + !--------------------------------------- + call shr_nuopc_methods_FB_getNumFlds(is_local%wrap%FBExp(compocn), trim(subname)//"FBexp(compocn)", ncnt, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (ncnt > 0) then + + !--------------------------------------- + !--- ocean accumulator + !--------------------------------------- + + call shr_nuopc_methods_FB_accum(is_local%wrap%FBExpAccum(compocn), is_local%wrap%FBExp(compocn), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + is_local%wrap%FBExpAccumCnt(compocn) = is_local%wrap%FBExpAccumCnt(compocn) + 1 + + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExpAccum(compocn), & + string=trim(subname)//' FBExpAccum accumulation ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + !--- clean up + !--------------------------------------- + endif + + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + end if + call t_stopf('MED:'//subname) + + end subroutine med_phases_prep_ocn_accum_fast + + !----------------------------------------------------------------------------- + + subroutine med_phases_prep_ocn_accum_avg(gcomp, rc) + + ! Prepare the OCN import Fields. + + use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FieldBundleGet + use med_constants_mod , only : czero=>med_constants_czero + use med_internalstate_mod , only : InternalState + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_average + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_copy + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_reset + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNumFlds + use esmFlds , only : compocn + use perf_mod , only : t_startf, t_stopf + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_Time) :: time + character(len=64) :: timestr + type(InternalState) :: is_local + integer :: i,j,n,ncnt + integer :: dbrc + character(len=*),parameter :: subname='(med_phases_prep_ocn_accum_avg)' + !--------------------------------------- + call t_startf('MED:'//subname) + + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + ! --- Count the number of fields outside of scalar data, if zero, then return + !--------------------------------------- + call shr_nuopc_methods_FB_getNumFlds(is_local%wrap%FBExpAccum(compocn), trim(subname)//"FBExpAccum(compocn)", ncnt, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (ncnt > 0) then + + !--------------------------------------- + !--- average ocn accumulator + !--------------------------------------- + + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExpAccum(compocn), & + string=trim(subname)//' FBExpAccum(compocn) before avg ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_average(is_local%wrap%FBExpAccum(compocn), & + is_local%wrap%FBExpAccumCnt(compocn), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compocn), & + string=trim(subname)//' FBExpAccum(compocn) after avg ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + !--- copy to FBExp(compocn) + !--------------------------------------- + + call shr_nuopc_methods_FB_copy(is_local%wrap%FBExp(compocn), is_local%wrap%FBExpAccum(compocn), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + !--- zero accumulator + !--------------------------------------- + + is_local%wrap%FBExpAccumFlag(compocn) = .true. + is_local%wrap%FBExpAccumCnt(compocn) = 0 + call shr_nuopc_methods_FB_reset(is_local%wrap%FBExpAccum(compocn), value=czero, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end if + + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + end if + call t_stopf('MED:'//subname) + + end subroutine med_phases_prep_ocn_accum_avg + +end module med_phases_prep_ocn_mod diff --git a/src/mediator/med_phases_prep_rof_mod.F90 b/src/mediator/med_phases_prep_rof_mod.F90 new file mode 100644 index 00000000..78e1bbe2 --- /dev/null +++ b/src/mediator/med_phases_prep_rof_mod.F90 @@ -0,0 +1,503 @@ +module med_phases_prep_rof_mod + + !----------------------------------------------------------------------------- + ! Create rof export fields + ! - accumulate import lnd fields on the land grid that are sent to rof + ! this will be done in med_phases_prep_rof_accum_fast + ! - time avergage accumulated import lnd fields when necessary + ! map the time averaged accumulated lnd fields to the rof grid + ! merge the mapped lnd fields to create FBExp(comprof) + ! this will be done in med_phases_prep_rof_avg + !----------------------------------------------------------------------------- + + use ESMF , only : ESMF_FieldBundle, ESMF_MAXSTR + use esmFlds , only : ncomps, complnd, comprof, compname, mapconsf + use med_constants_mod , only : R8, CS + use med_constants_mod , only : czero => med_constants_czero + use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_chkerr + use perf_mod , only : t_startf, t_stopf + + implicit none + private + + public :: med_phases_prep_rof_accum_fast + public :: med_phases_prep_rof_avg + + private :: med_phases_prep_rof_irrig + + type(ESMF_FieldBundle) :: FBlndVolr ! needed for lnd2rof irrigation + type(ESMF_FieldBundle) :: FBrofVolr ! needed for lnd2rof irrigation + type(ESMF_FieldBundle) :: FBlndIrrig ! needed for lnd2rof irrigation + type(ESMF_FieldBundle) :: FBrofIrrig ! needed for lnd2rof irrigation + + character(len=*), parameter :: volr_field = 'Flrr_volrmch' + character(len=*), parameter :: irrig_flux_field = 'Flrl_irrig' + character(len=*), parameter :: irrig_normalized_field = 'Flrl_irrig_normalized' + character(len=*), parameter :: irrig_volr0_field = 'Flrl_irrig_volr0' + + character(*) , parameter :: u_FILE_u = & + __FILE__ + +!----------------------------------------------------------------------------- +contains +!----------------------------------------------------------------------------- + + subroutine med_phases_prep_rof_accum_fast(gcomp, rc) + + ! Carry out fast accumulation for the river (rof) component + ! Accumulation and averaging is done on the land input to the river component on the land grid + ! Mapping from the land to the rof grid is then done with the time averaged fields + + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FieldBundleGet, ESMF_StateIsCreated, ESMF_StateGet + use ESMF , only : ESMF_FieldBundleIsCreated + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_accum + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use med_internalstate_mod , only : InternalState + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: i,j,n,ncnt + integer :: dbrc + character(len=*), parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof_accum_fast)' + !--------------------------------------- + + call t_startf('MED:'//subname) + + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + end if + rc = ESMF_SUCCESS + + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + !--- Count the number of fields outside of scalar data, if zero, then return + !--------------------------------------- + + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(complnd,complnd))) then + ncnt = 0 + else + ! The scalar field has been removed from all mediator field bundles - so check if the fieldCount is + ! 0 and not 1 here + call ESMF_FieldBundleGet(is_local%wrap%FBImp(complnd,complnd), fieldCount=ncnt, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + if (ncnt == 0) then + call ESMF_LogWrite(trim(subname)//": only scalar data is present in FBimp(complnd), returning", & + ESMF_LOGMSG_INFO, rc=dbrc) + else + + !--------------------------------------- + ! Accumulate lnd input on lnd grid to send to rof + !--------------------------------------- + call shr_nuopc_methods_FB_accum(is_local%wrap%FBImpAccum(complnd,complnd), & + is_local%wrap%FBImp(complnd,complnd), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + is_local%wrap%FBImpAccumCnt(complnd) = is_local%wrap%FBImpAccumCnt(complnd) + 1 + + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBImpAccum(complnd,complnd), & + string=trim(subname)//' FBImpAccum(complnd,complnd) ', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + end if + + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + end if + call t_stopf('MED:'//subname) + + end subroutine med_phases_prep_rof_accum_fast + + !----------------------------------------------------------------------------- + + subroutine med_phases_prep_rof_avg(gcomp, rc) + + ! Prepare the ROF export Fields from the mediator + + use NUOPC , only : NUOPC_IsConnected + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FieldBundleGet + use esmFlds , only : fldListTo, fldListFr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFldPtr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_average + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_reset + use med_merge_mod , only : med_merge_auto + use med_map_mod , only : med_map_FB_Regrid_Norm + use med_internalstate_mod , only : InternalState, mastertask + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: i,j,n,n1,ncnt + integer :: dbrc + logical :: connected + real(r8), pointer :: dataptr(:) + logical , save :: first_call = .true. + character(len=*),parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof_avg)' + !--------------------------------------- + + call t_startf('MED:'//subname) + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + end if + rc = ESMF_SUCCESS + + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + !--- Count the number of fields outside of scalar data, if zero, then return + !--------------------------------------- + + ! Note - the scalar field has been removed from all mediator field bundles - so this is why we check if the + ! fieldCount is 0 and not 1 here + + call ESMF_FieldBundleGet(is_local%wrap%FBExp(comprof), fieldCount=ncnt, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (ncnt == 0) then + + call ESMF_LogWrite(trim(subname)//": only scalar data is present in FBexp(comprof), returning", & + ESMF_LOGMSG_INFO, rc=dbrc) + else + + !--------------------------------------- + !--- average import from land accumuled FB + !--------------------------------------- + + call shr_nuopc_methods_FB_average(is_local%wrap%FBImpAccum(complnd,complnd), & + is_local%wrap%FBImpAccumCnt(complnd), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBImpAccum(complnd,complnd), & + string=trim(subname)//' FBImpAccum(complnd,complnd) after avg ', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + !--- map to create FBImpAccum(complnd,comprof) + !--------------------------------------- + + ! The following assumes that only land import fields are needed to create the + ! export fields for the river component and that ALL mappings are done with mapconsf + + if (is_local%wrap%med_coupling_active(complnd,comprof)) then + + call med_map_FB_Regrid_Norm( & + fldListFr(complnd)%flds, complnd, comprof, & + is_local%wrap%FBImpAccum(complnd,complnd), & + is_local%wrap%FBImpAccum(complnd,comprof), & + is_local%wrap%FBFrac(complnd), & + is_local%wrap%FBNormOne(complnd,comprof,:), & + is_local%wrap%RH(complnd,comprof,:), & + string=trim(compname(complnd))//'2'//trim(compname(comprof)), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBImpAccum(complnd,comprof), & + string=trim(subname)//' FBImpAccum(complnd,comprof) after avg ', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Reset the irrig_flux_field with the map_lnd2rof_irrig calculation below if appropriate + if ( NUOPC_IsConnected(is_local%wrap%NStateImp(complnd), fieldname=trim(irrig_flux_field))) then + call med_phases_prep_rof_irrig( gcomp, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + ! This will ensure that no irrig is sent from the land + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBImpAccum(complnd,comprof), & + trim(irrig_flux_field), dataptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr(:) = 0._r8 + end if + endif + + !--------------------------------------- + !--- auto merges to create FBExp(comprof) + !--------------------------------------- + + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBFrac(comprof), & + string=trim(subname)//' FBFrac(comprof) before merge ', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call med_merge_auto(trim(compname(comprof)), & + is_local%wrap%FBExp(comprof), & + is_local%wrap%FBFrac(comprof), & + is_local%wrap%FBImpAccum(:,comprof), & + fldListTo(comprof), & + document=first_call, string='(merge_to_rof)', mastertask=mastertask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(comprof), & + string=trim(subname)//' FBexp(comprof) ', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + !--- zero accumulator + !--------------------------------------- + + is_local%wrap%FBImpAccumCnt(complnd) = 0 + + call shr_nuopc_methods_FB_reset(is_local%wrap%FBImpAccum(complnd,complnd), value=czero, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + !--- custom calculations + !--------------------------------------- + + !--------------------------------------- + !--- clean up + !--------------------------------------- + + first_call = .false. + endif + + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + end if + call t_stopf('MED:'//subname) + + end subroutine med_phases_prep_rof_avg + + !----------------------------------------------------------------------------- + + subroutine med_phases_prep_rof_irrig(gcomp, rc) + + !--------------------------------------------------------------- + ! Description + ! Do custom mapping for the irrigation flux, from land -> rof. + ! + ! The basic idea is that we want to pull irrigation out of ROF cells proportionally to + ! the river volume (volr) in each cell. This is important in cases where the various + ! ROF cells overlapping a CTSM cell have very different volr: If we didn't do this + ! volr-normalized remapping, we'd try to extract the same amount of water from each + ! of the ROF cells, which would be more likely to have withdrawals exceeding + ! available volr. + ! + ! (Both RTM and MOSART have code to handle excess withdrawals by pulling the excess + ! directly out of the ocean. We'd like to avoid resorting to this if possible. + ! + ! This mapping works by: + ! (1) Normalizing the land's irrigation flux by volr + ! (2) Mapping this volr-normalized flux to the rof grid + ! (3) Converting the mapped, volr-normalized flux back to a normal + ! (non-volr-normalized) flux on the rof grid. + !--------------------------------------------------------------- + + use ESMF , only : ESMF_GridComp, ESMF_Field, ESMF_FieldRegrid + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_FieldBundleIsCreated + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_RouteHandleIsCreated + use ESMF , only : ESMF_LOGMSG_INFO, ESMF_LogWrite + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFldPtr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_init + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_reset + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_clean + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FieldRegrid + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use shr_nuopc_scalars_mod , only : flds_scalar_name + use med_internalstate_mod , only : InternalState, mastertask + use med_map_mod , only : med_map_FB_Regrid_norm + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + integer :: r,l + integer :: dbrc + type(InternalState) :: is_local + real(r8), pointer :: volr_l(:) + real(r8), pointer :: volr_r(:), volr_r_import(:) + real(r8), pointer :: irrig_normalized_l(:) + real(r8), pointer :: irrig_normalized_r(:) + real(r8), pointer :: irrig_volr0_l(:) + real(r8), pointer :: irrig_volr0_r(:) + real(r8), pointer :: irrig_flux_l(:) + real(r8), pointer :: irrig_flux_r(:) + character(len=*), parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof_irrig)' + !--------------------------------------------------------------- + + call t_startf('MED:'//subname) + + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + end if + rc = ESMF_SUCCESS + + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(complnd,comprof,mapconsf), rc=rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR conservativing route handle not created for lnd->rof mapping", & + ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + end if + if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(comprof,complnd,mapconsf), rc=rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR conservativing route handle not created for rof->lnd mapping", & + ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + end if + + ! ------------------------------------------------------------------------ + ! Initialize module field bundles if not already initialized + ! ------------------------------------------------------------------------ + + if (.not. ESMF_FieldBundleIsCreated(FBlndVolr) .and. & + .not. ESMF_FieldBundleIsCreated(FBrofVolr) .and. & + .not. ESMF_FieldBundleIsCreated(FBlndIrrig) .and. & + .not. ESMF_FieldBundleIsCreated(FBrofIrrig)) then + + call shr_nuopc_methods_FB_init(FBout=FBlndVolr, flds_scalar_name=flds_scalar_name, & + FBgeom=is_local%wrap%FBImp(complnd,complnd), & + fieldNameList=(/trim(volr_field)/), rc=rc) + if (chkerr(rc,__line__,u_file_u)) return + + call shr_nuopc_methods_FB_init(FBout=FBrofVolr, flds_scalar_name=flds_scalar_name, & + FBgeom=is_local%wrap%FBImp(comprof,comprof), & + fieldNameList=(/trim(volr_field)/), rc=rc) + if (chkerr(rc,__line__,u_file_u)) return + + call shr_nuopc_methods_FB_init(FBout=FBlndIrrig, flds_scalar_name=flds_scalar_name, & + FBgeom=is_local%wrap%FBImp(complnd,complnd), & + fieldNameList=(/trim(irrig_normalized_field), trim(irrig_volr0_field)/), rc=rc) + if (chkerr(rc,__line__,u_file_u)) return + + call shr_nuopc_methods_FB_init(FBout=FBrofIrrig, flds_scalar_name=flds_scalar_name, & + FBgeom=is_local%wrap%FBImp(comprof,comprof), & + fieldNameList=(/trim(irrig_normalized_field), trim(irrig_volr0_field)/), rc=rc) + if (chkerr(rc,__line__,u_file_u)) return + end if + + ! ------------------------------------------------------------------------ + ! 1) Create volr_l: Adjust volr_r, and map it to the land grid + ! ------------------------------------------------------------------------ + + ! Treat any rof point with volr < 0 as if it had volr = 0. Negative volr values can + ! arise in RTM. This fix is needed to avoid mapping negative irrigation to those + ! cells: while conservative, this would be unphysical (it would mean that irrigation + ! actually adds water to those cells). + + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBImp(comprof,comprof), & + trim(volr_field), volr_r_import, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_getFldPtr(FBrofVolr, trim(volr_field), volr_r, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do r = 1, size(volr_r) + if (volr_r_import(r) < 0._r8) then + volr_r(r) = 0._r8 + else + volr_r(r) = volr_r_import(r) + end if + end do + + ! Map volr_r to volr_l (rof->lnd) using conservative mapping without any fractional weighting + call shr_nuopc_methods_FB_FieldRegrid(FBrofVolr, trim(volr_field), FBlndVolr, trim(volr_field), & + is_local%wrap%RH(comprof, complnd, mapconsf), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Get volr_l + call shr_nuopc_methods_FB_getFldPtr(FBlndVolr, trim(volr_field), volr_l, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! ------------------------------------------------------------------------ + ! (2) Determine irrigation from land on land grid normalized by volr_l + ! ------------------------------------------------------------------------ + + ! In order to avoid possible divide by 0, as well as to handle non-sensical negative + ! volr on the land grid, we divide the land's irrigation flux into two separate flux + ! components: + ! - a component where we have positive volr on the land grid (put in + ! irrig_normalized_l, which is mapped using volr-normalization) + ! - a component where we have zero or negative volr on the land + ! grid (put in irrig_volr0_l, which is mapped as a standard flux). + ! We then remap both of these components to the rof grid, and then + ! finally add the two components to determine the total irrigation + ! flux on the rof grid. + + ! First extract accumulated irrigation flux from land + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBImpAccum(complnd,complnd), & + trim(irrig_flux_field), irrig_flux_l, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Fill in values for irrig_normalized_l and irrig_volr0_l in temporary FBlndIrrig field bundle + call shr_nuopc_methods_FB_getFldPtr(FBlndIrrig, trim(irrig_normalized_field), irrig_normalized_l, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_getFldPtr(FBlndIrrig, trim(irrig_volr0_field), irrig_volr0_l, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do l = 1, size(volr_l) + if (volr_l(l) > 0._r8) then + irrig_normalized_l(l) = irrig_flux_l(l) / volr_l(l) + irrig_volr0_l(l) = 0._r8 + else + irrig_normalized_l(l) = 0._r8 + irrig_volr0_l(l) = irrig_flux_l(l) + end if + end do + + ! ------------------------------------------------------------------------ + ! (3) Map normalized irrigation from land to rof grid and + ! convert to a total irrigation flux on the ROF grid + ! ------------------------------------------------------------------------ + + call med_map_FB_Regrid_Norm((/trim(irrig_normalized_field), trim(irrig_volr0_field)/), & + FBlndIrrig, FBrofIrrig, & + is_local%wrap%FBFrac(complnd), 'lfrin', & + is_local%wrap%RH(complnd, comprof, mapconsf), & + string='mapping normalized irrig from lnd to to rof', rc=rc) + + call shr_nuopc_methods_FB_getFldPtr(FBrofIrrig, trim(irrig_normalized_field), irrig_normalized_r, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_getFldPtr(FBrofIrrig, trim(irrig_volr0_field), irrig_volr0_r, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Convert to a total irrigation flux on the ROF grid, and put this in the pre-merge FBImpAccum(complnd,comprof) + call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBImpAccum(complnd,comprof), & + trim(irrig_flux_field), irrig_flux_r, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do r = 1, size(irrig_flux_r) + irrig_flux_r(r) = (irrig_normalized_r(r) * volr_r(r)) + irrig_volr0_r(r) + end do + + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + end if + call t_stopf('MED:'//subname) + + end subroutine med_phases_prep_rof_irrig + +end module med_phases_prep_rof_mod diff --git a/src/mediator/med_phases_prep_wav_mod.F90 b/src/mediator/med_phases_prep_wav_mod.F90 new file mode 100644 index 00000000..2213b76d --- /dev/null +++ b/src/mediator/med_phases_prep_wav_mod.F90 @@ -0,0 +1,152 @@ +module med_phases_prep_wav_mod + + !----------------------------------------------------------------------------- + ! Mediator Phases + !----------------------------------------------------------------------------- + + implicit none + private + + character(*) , parameter :: u_FILE_u = __FILE__ + + public :: med_phases_prep_wav + +!----------------------------------------------------------------------------- + contains +!----------------------------------------------------------------------------- + + subroutine med_phases_prep_wav(gcomp, rc) + use ESMF, only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF, only : ESMF_GridComp, ESMF_Clock, ESMF_Time + use ESMF, only : ESMF_GridCompGet, ESMF_FieldBundleGet, ESMF_ClockGet, ESMF_TimeGet + use ESMF, only : ESMF_ClockPrint + use med_constants_mod, only : CS + use esmFlds , only : compwav, ncomps, compname + use esmFlds , only : fldListFr, fldListTo + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag + use med_merge_mod , only : med_merge_auto + use med_map_mod , only : med_map_FB_Regrid_Norm + use med_internalstate_mod , only : InternalState, mastertask + use perf_mod , only : t_startf, t_stopf + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! Prepares the WAV import Fields. + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_Time) :: time + character(len=CS) :: timestr + type(InternalState) :: is_local + integer :: i,j,n,n1,ncnt + logical,save :: first_call = .true. + integer :: dbrc + character(len=*),parameter :: subname='(med_phases_prep_wav)' + !--------------------------------------- + call t_startf('MED:'//subname) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + rc = ESMF_SUCCESS + + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + !--- Count the number of fields outside of scalar data, if zero, then return + !--------------------------------------- + + ! Note - the scalar field has been removed from all mediator field bundles - so this is why we check if the + ! fieldCount is 0 and not 1 here + + call ESMF_FieldBundleGet(is_local%wrap%FBExp(compwav), fieldCount=ncnt, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (ncnt == 0) then + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": only scalar data is present in FBexp(compwav), returning", & + ESMF_LOGMSG_INFO, rc=dbrc) + endif + else + + !--------------------------------------- + !--- Get the current time from the clock + !--------------------------------------- + + call ESMF_GridCompGet(gcomp, clock=clock) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(clock,currtime=time,rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(time,timestring=timestr) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": time = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) + endif + + if (mastertask) then + call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//" mediating for: ", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + !--------------------------------------- + !--- map to create FBimp(:,compwav) + !--------------------------------------- + + do n1 = 1,ncomps + if (is_local%wrap%med_coupling_active(n1,compwav)) then + call med_map_FB_Regrid_Norm( & + fldListFr(n1)%flds, n1, compwav, & + is_local%wrap%FBImp(n1,n1), & + is_local%wrap%FBImp(n1,compwav), & + is_local%wrap%FBFrac(n1), & + is_local%wrap%FBNormOne(n1,compwav,:), & + is_local%wrap%RH(n1,compwav,:), & + string=trim(compname(n1))//'2'//trim(compname(compwav)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + enddo + + !--------------------------------------- + !--- auto merges + !--------------------------------------- + + call med_merge_auto(trim(compname(compwav)), & + is_local%wrap%FBExp(compwav), is_local%wrap%FBFrac(compwav), & + is_local%wrap%FBImp(:,compwav), fldListTo(compwav), & + document=first_call, string='(merge_to_wav)', mastertask=mastertask, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compwav), string=trim(subname)//' FBexp(compwav) ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + !--------------------------------------- + !--- custom calculations + !--------------------------------------- + + !--------------------------------------- + !--- update local scalar data + !--------------------------------------- + + !is_local%wrap%scalar_data(1) = + + !--------------------------------------- + !--- clean up + !--------------------------------------- + + first_call = .false. + endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call t_stopf('MED:'//subname) + + end subroutine med_phases_prep_wav + +end module med_phases_prep_wav_mod diff --git a/src/mediator/med_phases_profile_mod.F90 b/src/mediator/med_phases_profile_mod.F90 new file mode 100644 index 00000000..c0b011b5 --- /dev/null +++ b/src/mediator/med_phases_profile_mod.F90 @@ -0,0 +1,213 @@ +module med_phases_profile_mod + !----------------------------------------------------------------------------- + ! Output med profile to log file + !----------------------------------------------------------------------------- + use med_constants_mod, only : R8 + implicit none + private + + public :: med_phases_profile, med_phases_profile_finalize + + character(*), parameter :: u_FILE_u = & + __FILE__ + + real(R8) :: accumulated_time=0_R8, timestep_length + real(r8) :: previous_time=0_R8 + integer :: iterations=0 +!================================================================================= +contains +!================================================================================= + + subroutine med_phases_profile(gcomp, rc) + use ESMF, only : ESMF_VMGetCurrent, ESMF_CLOCK, ESMF_GridComp, ESMF_LogMsg_Info + use ESMF, only : ESMF_LogWrite, ESMF_GridCompGet, ESMF_SUCCESS, ESMF_VM + use ESMF, only : ESMF_VMGet, ESMF_ClockGetAlarm, ESMF_AlarmRingerOff + use ESMF, only : ESMF_Alarm, ESMF_AlarmisRinging, ESMF_VMWtime + use ESMF, only : ESMF_TimeSyncToRealTime, ESMF_Time, ESMF_TimeSet + use ESMF, only : ESMF_TimeInterval, ESMF_AlarmGet, ESMF_TimeIntervalGet + use ESMF, only : ESMF_ClockGetNextTime, ESMF_TimeGet, ESMF_ClockGet + use ESMF, only : operator(-) + use NUOPC, only : NUOPC_CompAttributeGet + use shr_nuopc_utils_mod, only : shr_nuopc_utils_chkerr, shr_nuopc_memcheck + use med_constants_mod, only : dbug_flag=>med_constants_dbug_flag, CS, CL + use med_internalstate_mod, only : mastertask, logunit + + use perf_mod, only : t_startf, t_stopf + use shr_mem_mod, only : shr_mem_getusage + + ! write profile output + + ! Input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + character(len=CS) :: cpl_inst_tag + type(ESMF_CLOCK) :: clock + type(ESMF_TIME) :: wallclocktime, nexttime + type(ESMF_TIME), save :: prevtime + type(ESMF_VM) :: vm + type(ESMF_Alarm) :: alarm, salarm + type(ESMF_TimeInterval) :: ringInterval, timestep + integer :: yr, mon, day, hr, min, sec + integer :: iam + logical :: ispresent + logical :: alarmison=.false., stopalarmison=.false. + real(R8) :: current_time, wallclockelapsed, ypd + real(r8) :: msize, mrss, ringdays + real(r8), save :: avgdt + character(len=CL) :: walltimestr, nexttimestr + character(len=*), parameter :: subname='(med_phases_profile)' + !--------------------------------------- + + call t_startf('MED:'//subname) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_SUCCESS + + call ESMF_VMGetCurrent(vm, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + if(isPresent) then + call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', value=cpl_inst_tag, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + else + cpl_inst_tag = "" + endif + + !--------------------------------------- + ! --- profiler Alarm + !--------------------------------------- + call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (iterations == 0) then + ! intialize and return + call ESMF_VMWtime(previous_time, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + ! Here we are just getting a single timestep interval + call ESMF_ClockGet( clock, timestep=timestep, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(clock, currTime=prevtime, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeIntervalGet(timestep, d_r8=timestep_length, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + iterations = 1 + else + !--------------------------------------- + ! --- Get the clock info + !--------------------------------------- + + call ESMF_ClockGetAlarm(clock, alarmname='med_profile_alarm', alarm=alarm, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + alarmIsOn = .true. + call ESMF_AlarmRingerOff( alarm, rc=rc ) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_ClockGetAlarm(clock, alarmname='alarm_stop', alarm=salarm, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (ESMF_AlarmIsRinging(salarm, rc=rc)) then + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + stopalarmIsOn = .true. + call ESMF_AlarmRingerOff( salarm, rc=rc ) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + else + AlarmIsOn = .false. + stopalarmison = .false. + endif + endif + if ((stopalarmison .or. alarmIsOn .or. iterations==1) .and. mastertask) then + ! We need to get the next time for display + call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMWtime(current_time, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + wallclockelapsed = current_time - previous_time + accumulated_time = accumulated_time + wallclockelapsed + + if (alarmison) then + call ESMF_AlarmGet( alarm, ringInterval=ringInterval, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeIntervalGet(ringInterval, d_r8=ringdays, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + avgdt = accumulated_time/(ringdays*real(iterations-1)) + else if (stopalarmison) then + ! Here we need the interval since the last call to this function + call ESMF_TimeIntervalGet(nexttime-prevtime, d_r8=ringdays, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + else + avgdt = wallclockelapsed/timestep_length + ringdays = timestep_length + endif + prevtime = nexttime + call ESMF_TimeGet(nexttime, timestring=nexttimestr, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + ! get current wall clock time + call ESMF_TimeSet(wallclocktime, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSyncToRealTime(wallclocktime, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(wallclocktime,timeString=walltimestr, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + + ! 1 model day/ x seconds = 1/365 yrs/ (wallclockelapsed s/86400spd + ypd = ringdays*86400.0_R8/(365.0_R8*wallclockelapsed) + + write(logunit,101) 'Model Date: ',trim(nexttimestr), ' wall clock = ',trim(walltimestr),' avg dt = ', & + avgdt, 's/day, dt = ',wallclockelapsed/ringdays,'s/day, rate = ',ypd,' ypd' + call shr_mem_getusage(msize,mrss,.true.) + + write(logunit,105) ' memory_write: model date = ',trim(nexttimestr), & + ' memory = ',msize,' MB (highwater) ',mrss,' MB (usage)' + previous_time = current_time + endif + endif + iterations = iterations + 1 + +101 format( 5A, F8.2, A, F8.2, A, F8.2, A) +105 format( 3A, f10.2, A, f10.2, A) + !--------------------------------------- + !--- clean up + !--------------------------------------- + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + call t_stopf('MED:'//subname) + + end subroutine med_phases_profile + + subroutine med_phases_profile_finalize() + use ESMF, only : ESMF_VMWtime + use med_internalstate_mod, only : logunit + use shr_nuopc_utils_mod, only : shr_nuopc_utils_chkerr + + real(r8) :: SYPD + character(*), parameter :: FormatR = '(": =============== ", A31,F12.3,1x, " ===============")' + real(r8) :: current_time, wallclockelapsed + integer :: rc + + call ESMF_VMWtime(current_time, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + wallclockelapsed = current_time - previous_time + accumulated_time = accumulated_time + wallclockelapsed + + SYPD = real(iterations-1,R8)*timestep_length*86400.0_R8/(365.0_R8*accumulated_time) + write(logunit,FormatR) '# simulated years / cmp-day = ', SYPD + + end subroutine med_phases_profile_finalize + + +end module med_phases_profile_mod diff --git a/src/mediator/med_phases_restart_mod.F90 b/src/mediator/med_phases_restart_mod.F90 new file mode 100644 index 00000000..fab1b2e3 --- /dev/null +++ b/src/mediator/med_phases_restart_mod.F90 @@ -0,0 +1,510 @@ +module med_phases_restart_mod + + !----------------------------------------------------------------------------- + ! Write/Read mediator restart files + !----------------------------------------------------------------------------- + + implicit none + private + + public :: med_phases_restart_read + public :: med_phases_restart_write + + character(*), parameter :: u_FILE_u = & + __FILE__ + +!================================================================================= +contains +!================================================================================= + + subroutine med_phases_restart_write(gcomp, rc) + + ! Write mediator restart + + use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_Clock, ESMF_Time, ESMF_Alarm + use ESMF , only : ESMF_TimeInterval, ESMF_CalKind_Flag, ESMF_MAXSTR + use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_LOGMSG_ERROR, operator(==), operator(-) + use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_ClockGet, ESMF_ClockGetNextTime + use ESMF , only : ESMF_TimeGet, ESMF_ClockGetAlarm, ESMF_ClockPrint, ESMF_TimeIntervalGet + use ESMF , only : ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_FieldBundleIsCreated + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use med_constants_mod , only : SecPerDay => med_constants_SecPerDay + use med_constants_mod , only : med_constants_noleap + use med_constants_mod , only : med_constants_gregorian + use med_constants_mod , only : R8 + use NUOPC , only : NUOPC_CompAttributeGet + use esmFlds , only : ncomps, compname, compocn + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use med_internalstate_mod , only : InternalState + use med_infodata_mod , only : med_infodata, med_infodata_GetData + use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit + use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef + use med_io_mod , only : med_io_close, med_io_date2yyyymmdd + use med_io_mod , only : med_io_sec2hms + use perf_mod , only : t_startf, t_stopf + + ! Input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_VM) :: vm + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currtime, reftime, starttime, nexttime + type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time + type(ESMF_Alarm) :: alarm + type(ESMF_CalKind_Flag) :: calkindflag + character(len=64) :: currtimestr, nexttimestr + type(InternalState) :: is_local + integer :: i,j,m,n,n1,ncnt + integer :: curr_ymd ! Current date YYYYMMDD + integer :: curr_tod ! Current time-of-day (s) + integer :: start_ymd ! Starting date YYYYMMDD + integer :: start_tod ! Starting time-of-day (s) + integer :: ref_ymd ! Reference date YYYYMMDD + integer :: ref_tod ! Reference time-of-day (s) + integer :: next_ymd ! Starting date YYYYMMDD + integer :: next_tod ! Starting time-of-day (s) + integer :: nx,ny ! global grid size + integer :: yr,mon,day,sec ! time units + real(R8) :: dayssince ! Time interval since reference time + integer :: unitn ! unit number + character(ESMF_MAXSTR) :: time_units ! units of time variable + character(ESMF_MAXSTR) :: calendar ! calendar type + character(ESMF_MAXSTR) :: case_name ! case name + character(ESMF_MAXSTR) :: restart_file ! Local path to restart filename + character(ESMF_MAXSTR) :: restart_pfile ! Local path to restart pointer filename + character(ESMF_MAXSTR) :: cpl_inst_tag ! instance tag + character(ESMF_MAXSTR) :: cvalue ! attribute string + character(ESMF_MAXSTR) :: freq_option ! freq_option setting (ndays, nsteps, etc) + integer :: freq_n ! freq_n setting relative to freq_option + logical :: alarmIsOn ! generic alarm flag + real(R8) :: tbnds(2) ! CF1.0 time bounds + logical :: whead,wdata ! for writing restart/restart cdf files + integer :: iam ! vm stuff + character(len=ESMF_MAXSTR) :: tmpstr + integer :: dbrc + logical :: isPresent + character(len=*), parameter :: subname='(med_phases_restart_write)' + !--------------------------------------- + + call t_startf('MED:'//subname) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if(isPresent) then + call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', value=cpl_inst_tag, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else + cpl_inst_tag = "" + endif + + !--------------------------------------- + ! --- Get the clock info + !--------------------------------------- + + call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + ! --- Restart Alarm + !--------------------------------------- + + call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (ESMF_AlarmIsRinging(alarm, rc=rc)) then + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + alarmIsOn = .true. + call ESMF_AlarmRingerOff( alarm, rc=rc ) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else + AlarmIsOn = .false. + endif + + if (alarmIsOn) then + call ESMF_ClockGet(clock, currtime=currtime, reftime=reftime, starttime=starttime, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(clock, calkindflag=calkindflag, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (calkindflag == ESMF_CALKIND_GREGORIAN) then + calendar = med_constants_gregorian + elseif (calkindflag == ESMF_CALKIND_NOLEAP) then + calendar = med_constants_noleap + else + call ESMF_LogWrite(trim(subname)//' ERROR: calendar not supported', ESMF_LOGMSG_ERROR, rc=dbrc) + rc=ESMF_Failure + return + endif + + call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO, rc=dbrc) + endif + + call ESMF_TimeGet(nexttime,yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": nexttime = "//trim(nexttimestr), ESMF_LOGMSG_INFO, rc=dbrc) + endif + + call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//" mediating for: ", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + timediff = nexttime - reftime + call ESMF_TimeIntervalGet(timediff, d=day, s=sec, rc=rc) + dayssince = day + sec/real(SecPerDay,R8) + + call ESMF_TimeGet(reftime, yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) + call ymd2date(yr,mon,day,start_ymd) + start_tod = sec + time_units = 'days since ' & + // trim(med_io_date2yyyymmdd(start_ymd)) // ' ' // med_io_sec2hms(start_tod) + + call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) + call ymd2date(yr,mon,day,next_ymd) + next_tod = sec + + call ESMF_TimeGet(reftime, yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) + call ymd2date(yr,mon,day,ref_ymd) + ref_tod = sec + + call ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) + call ymd2date(yr,mon,day,curr_ymd) + curr_tod = sec + + !--------------------------------------- + ! --- Restart File + ! Use nexttimestr rather than currtimestr here since that is the time at the end of + ! the timestep and is preferred for restart file names + !--------------------------------------- + + write(restart_file,"(6a)") & + trim(case_name), '.cpl',trim(cpl_inst_tag),'.r.', trim(nexttimestr),'.nc' + + if (iam == 0) then + restart_pfile = "rpointer.med"//cpl_inst_tag + call ESMF_LogWrite(trim(subname)//" write rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO, rc=dbrc) + unitn = shr_file_getUnit() + open(unitn, file=restart_pfile, form='FORMATTED') + write(unitn,'(a)') trim(restart_file) + close(unitn) + call shr_file_freeUnit( unitn ) + endif + + call ESMF_LogWrite(trim(subname)//": write "//trim(restart_file), ESMF_LOGMSG_INFO, rc=dbrc) + call med_io_wopen(restart_file, vm, iam, clobber=.true.) + + do m = 1,2 + if (m == 1) then + whead = .true. + wdata = .false. + else if (m == 2) then + whead = .false. + wdata = .true. + endif + if (wdata) then + call med_io_enddef(restart_file) + end if + + tbnds = dayssince + call ESMF_LogWrite(trim(subname)//": time "//trim(time_units), ESMF_LOGMSG_INFO, rc=dbrc) + if (tbnds(1) >= tbnds(2)) then + call med_io_write(restart_file, iam=iam, & + time_units=time_units, time_cal=calendar, time_val=dayssince, & + whead=whead, wdata=wdata) + else + call med_io_write(restart_file, iam=iam, & + time_units=time_units, time_cal=calendar, time_val=dayssince, & + whead=whead, wdata=wdata, tbnds=tbnds) + endif + + ! Write out next ymd/tod in place of curr ymd/tod because + ! the currently the restart represents the time at end of + ! the current timestep and that is where we want to start + ! the next run. + + call med_io_write(restart_file, iam, start_ymd, 'start_ymd', whead=whead, wdata=wdata) + call med_io_write(restart_file, iam, start_tod, 'start_tod', whead=whead, wdata=wdata) + call med_io_write(restart_file, iam, ref_ymd , 'ref_ymd' , whead=whead, wdata=wdata) + call med_io_write(restart_file, iam, ref_tod , 'ref_tod' , whead=whead, wdata=wdata) + call med_io_write(restart_file, iam, next_ymd , 'curr_ymd' , whead=whead, wdata=wdata) + call med_io_write(restart_file, iam, next_tod , 'curr_tod' , whead=whead, wdata=wdata) + + call med_io_write(restart_file, iam, is_local%wrap%FBExpAccumCnt, dname='ExpAccumCnt', & + whead=whead, wdata=wdata) + !if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1,ncomps + if (is_local%wrap%comp_present(n)) then + ! Write import field bundles + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then + call med_infodata_GetData(med_infodata, ncomp=n, nx=nx, ny=ny) + !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny + !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call med_io_write(restart_file, iam, is_local%wrap%FBimp(n,n), & + nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Imp', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + ! Write fraction field bundles + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then + call med_infodata_GetData(med_infodata, ncomp=n, nx=nx, ny=ny) + !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny + !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call med_io_write(restart_file, iam, is_local%wrap%FBfrac(n), & + nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Frac', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + ! Write export accumulators + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccum(n),rc=rc)) then + ! TODO: only write this out if actually have done accumulation + call med_infodata_GetData(med_infodata, ncomp=n, nx=nx, ny=ny) + !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny + !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call med_io_write(restart_file, iam, is_local%wrap%FBExpAccum(n), & + nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'ExpAccum', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + endif + enddo + + !Write ocn albedo field bundle (CESM only) + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then + call med_infodata_GetData(med_infodata, ncomp=compocn, nx=nx, ny=ny) + call med_io_write(restart_file, iam, is_local%wrap%FBMed_ocnalb_o, & + nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='MedOcnAlb_o', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + enddo + + ! Close file + call med_io_close(restart_file, iam) + endif + + !--------------------------------------- + !--- clean up + !--------------------------------------- + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + call t_stopf('MED:'//subname) + + end subroutine med_phases_restart_write + + !=============================================================================== + subroutine med_phases_restart_read(gcomp, rc) + + ! Read mediator restart + + use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_Clock, ESMF_Time, ESMF_MAXSTR + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_VMBroadCast + use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_ClockGet, ESMF_ClockPrint + use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_TimeGet + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use NUOPC , only : NUOPC_CompAttributeGet + use esmFlds , only : ncomps, compname + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use med_internalstate_mod , only : InternalState + use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit + use med_io_mod , only : med_io_read + use perf_mod , only : t_startf, t_stopf + ! Input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! Local variables + type(ESMF_VM) :: vm + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currtime + character(len=64) :: currtimestr + type(InternalState) :: is_local + integer :: i,j,m,n,n1,ncnt + integer :: ierr, unitn + integer :: yr,mon,day,sec ! time units + integer :: iam ! vm stuff + character(ESMF_MAXSTR) :: case_name ! case name + character(ESMF_MAXSTR) :: restart_file ! Local path to restart filename + character(ESMF_MAXSTR) :: restart_pfile ! Local path to restart pointer filename + character(ESMF_MAXSTR) :: cpl_inst_tag ! instance tag + character(len=*) , parameter :: sp_str = 'str_undefined' + integer :: dbrc + logical :: isPresent + character(len=*), parameter :: subname='(med_phases_restart_read)' + !--------------------------------------- + call t_startf('MED:'//subname) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + rc = ESMF_SUCCESS + + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if(isPresent) then + call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', value=cpl_inst_tag, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else + cpl_inst_tag = "" + endif + + !--------------------------------------- + ! --- Get the clock info + !--------------------------------------- + + call ESMF_GridCompGet(gcomp, clock=clock) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(clock, currtime=currtime, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO, rc=dbrc) + endif + if (iam==0) then + call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//" mediating for: ", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + !--------------------------------------- + ! --- Restart File + !--------------------------------------- + + + restart_pfile = "rpointer.med"//cpl_inst_tag + + if (iam == 0) then + unitn = shr_file_getUnit() + call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO, rc=dbrc) + open(unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) + if (ierr < 0) then + call ESMF_LogWrite(trim(subname)//' rpointer file open returns error', ESMF_LOGMSG_INFO, rc=dbrc) + rc=ESMF_Failure + return + end if + read(unitn,'(a)', iostat=ierr) restart_file + if (ierr < 0) then + call ESMF_LogWrite(trim(subname)//' rpointer file read returns error', ESMF_LOGMSG_INFO, rc=dbrc) + rc=ESMF_Failure + return + end if + close(unitn) + call shr_file_freeUnit( unitn ) + call ESMF_LogWrite(trim(subname)//' restart file from rpointer = '//trim(restart_file), & + ESMF_LOGMSG_INFO, rc=dbrc) + endif + call ESMF_VMBroadCast(vm, restart_file, len(restart_file), 0, rc=rc) + + call ESMF_LogWrite(trim(subname)//": read "//trim(restart_file), ESMF_LOGMSG_INFO, rc=dbrc) + + call med_io_read(restart_file, vm, iam, is_local%wrap%FBExpAccumCnt, dname='ExpAccumCnt') + + do n = 1,ncomps + if (is_local%wrap%comp_present(n)) then + ! Read import field bundle + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then + call med_io_read(restart_file, vm, iam, is_local%wrap%FBimp(n,n), & + pre=trim(compname(n))//'Imp', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + ! Read import fractions + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then + call med_io_read(restart_file, vm, iam, is_local%wrap%FBfrac(n), & + pre=trim(compname(n))//'Frac', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + ! Read export field bundle accumulator + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccum(n),rc=rc)) then + call med_io_read(restart_file, vm, iam, is_local%wrap%FBExpAccum(n), & + pre=trim(compname(n))//'ExpAccum', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + endif + enddo + + ! Read ocn albedo field bundle (CESM only) + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then + call med_io_read(restart_file, vm, iam, is_local%wrap%FBMed_ocnalb_o, & + pre='MedOcnAlb_o', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + !--------------------------------------- + !--- clean up + !--------------------------------------- + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call t_stopf('MED:'//subname) + + end subroutine med_phases_restart_read + + + !=============================================================================== + subroutine ymd2date(year,month,day,date) + ! Converts year, month, day to coded-date + ! NOTE: this calendar has a year zero (but no day or month zero) + + integer,intent(in ) :: year,month,day ! calendar year,month,day + integer,intent(out) :: date ! coded (yyyymmdd) calendar date + + ! local variables + character(*),parameter :: subName = "(ymd2date)" + !--------------------------------------- + + date = abs(year)*10000 + month*100 + day ! coded calendar date + if (year < 0) date = -date + end subroutine ymd2date + +end module med_phases_restart_mod diff --git a/src/shr/CMakeLists.txt b/src/shr/CMakeLists.txt new file mode 100644 index 00000000..03b69fd6 --- /dev/null +++ b/src/shr/CMakeLists.txt @@ -0,0 +1,9 @@ +list(APPEND drv_sources + glc_elevclass_mod.F90 + seq_cdata_mod.F90 + seq_comm_mct.F90 + seq_infodata_mod.F90 + seq_io_read_mod.F90 + ) + +sourcelist_to_parent(drv_sources) \ No newline at end of file diff --git a/src/shr/med_constants_mod.F90 b/src/shr/med_constants_mod.F90 new file mode 100644 index 00000000..c5e1f045 --- /dev/null +++ b/src/shr/med_constants_mod.F90 @@ -0,0 +1,41 @@ +module med_constants_mod + + !----------------------------------------------------------------------------- + ! Used by all components and mediator + !----------------------------------------------------------------------------- + + use shr_kind_mod , only : R8=>SHR_KIND_R8 + use shr_kind_mod , only : R4=>SHR_KIND_R4 + use shr_kind_mod , only : IN=>SHR_KIND_IN + use shr_kind_mod , only : I8=>SHR_KIND_I8 + use shr_kind_mod , only : CL=>SHR_KIND_CL + use shr_kind_mod , only : CS=>SHR_KIND_CS + use shr_kind_mod , only : CX=>SHR_KIND_CX + use shr_kind_mod , only : CXX=>SHR_KIND_CXX + + use shr_cal_mod , only : med_constants_noleap => shr_cal_noleap + use shr_cal_mod , only : med_constants_gregorian => shr_cal_gregorian + use shr_log_mod , only : shr_log_Unit + use shr_cal_mod , only : shr_cal_ymd2date + use shr_cal_mod , only : shr_cal_noleap + use shr_cal_mod , only : shr_cal_gregorian + use shr_file_mod , only : shr_file_getlogunit + use shr_file_mod , only : shr_file_setlogunit + use shr_file_mod , only : shr_file_getloglevel + use shr_file_mod , only : shr_file_setloglevel + use shr_file_mod , only : shr_file_getUnit + use shr_file_mod , only : shr_file_setIO + + implicit none + + logical, parameter :: med_constants_statewrite_flag = .false. + real(R8), parameter :: med_constants_spval_init = 0.0_R8 ! spval for initialization + real(R8), parameter :: med_constants_spval = 0.0_R8 ! spval + real(R8), parameter :: med_constants_czero = 0.0_R8 ! spval + integer, parameter :: med_constants_ispval_mask = -987987 ! spval for RH mask values + integer, parameter :: med_constants_SecPerDay = 86400 ! Seconds per day + + !----------------------------------------------------------------------------- + integer :: med_constants_dbug_flag = 0 + +end module med_constants_mod diff --git a/src/shr/shr_expr_parser_mod.F90 b/src/shr/shr_expr_parser_mod.F90 new file mode 100644 index 00000000..f37a4ac3 --- /dev/null +++ b/src/shr/shr_expr_parser_mod.F90 @@ -0,0 +1,185 @@ +!============================================================================= +! expression parser utility -- +! for parsing simple linear mathematical expressions of the form +! X = a*Y + b*Z + ... +! +!============================================================================= +module shr_expr_parser_mod + use shr_kind_mod,only : r8 => shr_kind_r8 + use shr_kind_mod,only : cx => shr_kind_cx + + implicit none + private + + public :: shr_exp_parse ! parses simple strings which contain expressions + public :: shr_exp_item_t ! user defined type which contains an expression component + public :: shr_exp_list_destroy ! destroy the linked list returned by shr_exp_parse + + ! contains componets of expression + type shr_exp_item_t + character(len=64) :: name + character(len=64),pointer :: vars(:) => null() + real(r8) ,pointer :: coeffs(:) => null() + integer :: n_terms = 0 + type(shr_exp_item_t), pointer :: next_item => null() + end type shr_exp_item_t + +contains + + ! ----------------------------------------------------------------- + ! parses expressions provided in array of strings + ! ----------------------------------------------------------------- + function shr_exp_parse( exp_array, nitems ) result(exp_items_list) + + character(len=*), intent(in) :: exp_array(:) ! contains a expressions + integer, optional, intent(out) :: nitems ! number of expressions parsed + type(shr_exp_item_t), pointer :: exp_items_list ! linked list of items returned + + integer :: i,j, jj, nmax, nterms, n_exp_items + character(len=cx) :: tmp_str + type(shr_exp_item_t), pointer :: exp_item, list_item + + nullify( exp_items_list ) + nullify( exp_item ) + nullify( list_item ) + + n_exp_items = 0 + nmax = size( exp_array ) + + do i = 1,nmax + if (len_trim(exp_array(i))>0) then + + j = scan( exp_array(i), '=' ) + + if ( j>0 ) then + + n_exp_items = n_exp_items + 1 + + allocate( exp_item ) + exp_item%n_terms = 0 + exp_item%name = trim(adjustl(exp_array(i)(:j-1))) + + tmp_str = trim(adjustl(exp_array(i)(j+1:))) + + nterms = 1 + jj = scan( tmp_str, '+' ) + do while(jj>0) + nterms = nterms + 1 + tmp_str = tmp_str(jj+1:) + jj = scan( tmp_str, '+' ) + enddo + + allocate( exp_item%vars(nterms) ) + allocate( exp_item%coeffs(nterms) ) + + tmp_str = trim(adjustl(exp_array(i)(j+1:))) + + j = scan( tmp_str, '+' ) + + if (j>0) then + call set_coefvar( tmp_str(:j-1), exp_item ) + tmp_str = tmp_str(j-1:) + else + call set_coefvar( tmp_str, exp_item ) + endif + + else + + tmp_str = trim(adjustl(exp_array(i))) ! assumed to begin with '+' + + endif + + ! at this point tmp_str begins with '+' + j = scan( tmp_str, '+' ) + + if (j>0) then + + ! remove the leading + ... + tmp_str = tmp_str(j+1:) + j = scan( tmp_str, '+' ) + + do while(j>0) + + call set_coefvar( tmp_str(:j-1), exp_item ) + + tmp_str = tmp_str(j+1:) + j = scan( tmp_str, '+' ) + + enddo + + call set_coefvar( tmp_str, exp_item ) + + endif + + + if (associated(exp_item)) then + if (associated(exp_items_list)) then + list_item => exp_items_list + do while(associated(list_item%next_item)) + list_item => list_item%next_item + enddo + list_item%next_item => exp_item + else + exp_items_list => exp_item + endif + endif + + endif + enddo + + if ( present(nitems) ) then + nitems = n_exp_items + endif + + end function shr_exp_parse + + ! ----------------------------------------------------------------- + ! deallocates memory occupied by linked list + ! ----------------------------------------------------------------- + subroutine shr_exp_list_destroy( list ) + type(shr_exp_item_t), pointer, intent(inout) :: list + + type(shr_exp_item_t), pointer :: item, next + + item => list + do while(associated(item)) + next => item%next_item + if (associated(item%vars)) then + deallocate(item%vars) + nullify(item%vars) + deallocate(item%coeffs) + nullify(item%coeffs) + endif + deallocate(item) + nullify(item) + item => next + enddo + + end subroutine shr_exp_list_destroy + + !========================== + ! Private Methods + + ! ----------------------------------------------------------------- + ! ----------------------------------------------------------------- + subroutine set_coefvar( term, item ) + character(len=*), intent(in) :: term + type(shr_exp_item_t) , intent(inout) :: item + + integer :: k, n + + item%n_terms = item%n_terms + 1 + n = item%n_terms + + k = scan( term, '*' ) + if (k>0) then + item%vars(n) = trim(adjustl(term(k+1:))) + read( term(:k-1), *) item%coeffs(n) + else + item%vars(n) = trim(adjustl(term)) + item%coeffs(n) = 1.0_r8 + endif + + end subroutine set_coefvar + +end module shr_expr_parser_mod diff --git a/src/shr/shr_nuopc_grid_mod.F90 b/src/shr/shr_nuopc_grid_mod.F90 new file mode 100644 index 00000000..dae5f46c --- /dev/null +++ b/src/shr/shr_nuopc_grid_mod.F90 @@ -0,0 +1,393 @@ +!================================================================================ +module shr_nuopc_grid_mod + use shr_nuopc_utils_mod, only : shr_nuopc_utils_ChkErr + implicit none + private + + public :: shr_nuopc_grid_MeshInit + public :: shr_nuopc_grid_ArrayToState + public :: shr_nuopc_grid_StateToArray + + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!----------------------------------------------------------------------------- +contains +!----------------------------------------------------------------------------- + subroutine shr_nuopc_grid_MeshInit(gcomp, nx_global, ny_global, gindex, lon, lat, Emesh, rc) + + !----------------------------------------- + ! create an Emesh object for Fields + !----------------------------------------- + use shr_kind_mod, only : R8=>shr_kind_r8 + use ESMF, only : ESMF_GridComp, ESMF_VM, ESMF_Mesh + use ESMF, only : ESMF_VMGet, ESMF_GridCompGet, ESMF_VMBroadCast, ESMF_VMAllGatherV + use ESMF, only : ESMF_SUCCESS, ESMF_LOGMSG_INFO, ESMF_LogWrite + use ESMF, only : ESMF_VMGather, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU + use ESMF, only : ESMF_MeshCreate, ESMF_COORDSYS_SPH_DEG, ESMF_REDUCE_SUM + use ESMF, only : ESMF_VMAllReduce, ESMF_MESHELEMTYPE_QUAD + + type(ESMF_GridComp) :: gcomp + integer , intent(in) :: nx_global + integer , intent(in) :: ny_global + integer , intent(in) :: gindex(:) + real(r8), pointer , intent(in) :: lon(:) + real(r8), pointer , intent(in) :: lat(:) + type(ESMF_Mesh) , intent(inout) :: Emesh + integer , intent(inout) :: rc + + !--- local --- + integer :: n,n1,n2,de + integer :: iam + integer :: lsize + integer :: numTotElems, numNodes, numConn, nodeindx + integer :: iur,iul,ill,ilr + integer :: xid, yid, xid0, yid0 + real(r8) :: lonur, lonul, lonll, lonlr + integer, pointer :: iurpts(:) + integer, pointer :: elemIds(:) + integer, pointer :: elemTypes(:) + integer, pointer :: elemConn(:) + real(r8),pointer :: elemCoords(:) + integer, pointer :: nodeIds(:) + integer, pointer :: nodeOwners(:) + real(r8),pointer :: nodeCoords(:) + real(r8),pointer :: latG(:) + real(r8),pointer :: lonG(:) + integer ,pointer :: pes_local(:) + integer ,pointer :: pes_global(:) + integer, pointer :: recvOffsets(:) + integer, pointer :: recvCounts(:) + integer :: sendData(1) + type(ESMF_VM) :: vm + integer :: petCount + character(len=*),parameter :: subname='(shr_nuopc_grid_MeshInit)' + !-------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_LogWrite(subname, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + lsize = size(gindex) + + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, petCount=petCount, localpet=iam, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + allocate(latG(nx_global*ny_global)) + allocate(lonG(nx_global*ny_global)) + + allocate(recvoffsets(petCount)) + allocate(recvCounts(petCount)) + + sendData(1) = lsize + call ESMF_VMGather(vm, sendData=sendData, recvData=recvCounts, count=1, rootPet=0, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMBroadCast(vm, bcstData=recvCounts, count=petCount, rootPet=0, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + recvoffsets(1) = 0 + do n = 2,petCount + recvoffsets(n) = recvoffsets(n-1) + recvCounts(n-1) + end do + + call ESMF_VMAllGatherV(vm, lat, lsize, latG, recvCounts, recvOffsets, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMAllGatherV(vm, lon, lsize, lonG, recvCounts, recvOffsets, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + deallocate(recvoffsets) + deallocate(recvCounts) + + ! assumes quadrilaterals for each gridcell (element) + ! element index matches gsmap index value + ! nodeid at lower left of each gridcell matches gsmap index value + ! assumes wrap around in x direction but no wrap in y direction + ! node ids need to be described in counter clockwise direction + ! node id associated with lower left cell is assigned to local PET + ! node ids at top of y boundary assigned to the element to the right + + numTotElems = lsize + + allocate(elemIds(numTotElems)) + allocate(elemTypes(numTotElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD/) + allocate(elemConn(4*numTotElems)) + allocate(elemCoords(2*numTotElems)) + + allocate(nodeIds(numTotElems*4)) + nodeIds = -99 + + elemIds(:) = gindex(:) + numNodes = 0 + numConn = 0 + + do n = 1,numTotElems + elemTypes(n) = ESMF_MESHELEMTYPE_QUAD + elemCoords(2*n-1) = lon(n) + elemCoords(2*n) = lat(n) + + do n1 = 1,4 + + numNodes = numNodes + 1 + nodeindx = numNodes + if (n1 == 1 .or. n1 == 3) xid = mod(elemIds(n)-1,nx_global) + 1 + if (n1 == 2 .or. n1 == 4) xid = mod(elemIds(n) ,nx_global) + 1 + if (n1 == 1 .or. n1 == 2) yid = (elemIds(n)-1)/nx_global + 1 + if (n1 == 3 .or. n1 == 4) yid = (elemIds(n)-1)/nx_global + 2 + nodeIds(numNodes) = (yid-1) * nx_global + xid + n2 = 0 + do while (n2 < numNodes - 1 .and. nodeindx == numNodes) + n2 = n2 + 1 + if (nodeIds(numNodes) == nodeIds(n2)) nodeindx = n2 + enddo + if (nodeindx /= numNodes) then + numNodes = numNodes - 1 + endif + + numConn = numConn + 1 + elemConn(numConn) = nodeindx + enddo + enddo + + + allocate(nodeCoords(2*numNodes)) + allocate(nodeOwners(numNodes)) + allocate(iurpts(numNodes)) + + do n = 1,numNodes + + xid0 = mod(nodeIds(n)-1, nx_global) + 1 + yid0 = (nodeIds(n)-1) / nx_global + 1 + + xid = xid0 + yid = max(min(yid0,ny_global),1) + iur = (yid-1) * nx_global + xid + iurpts(n) = iur + + xid = mod(xid0 - 2 + nx_global, nx_global) + 1 + yid = max(min(yid0,ny_global),1) + iul = (yid-1) * nx_global + xid + + xid = mod(xid0 - 2 + nx_global, nx_global) + 1 + yid = max(min(yid0-1,ny_global),1) + ill = (yid-1) * nx_global + xid + + xid = xid0 + yid = max(min(yid0-1,ny_global),1) + ilr = (yid-1) * nx_global + xid + + ! write(tmpstr,'(2a,8i6)') subname,' nodecoord = ',n,nodeIds(n),xid0,yid0,iur,iul,ill,ilr + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + ! need to normalize lon values to same 360 degree setting, use lonur as reference value + lonur = lonG(iur) + lonul = lonG(iul) + lonll = lonG(ill) + lonlr = lonG(ilr) + + if (abs(lonul + 360._r8 - lonur) < abs(lonul - lonur)) lonul = lonul + 360._r8 + if (abs(lonul - 360._r8 - lonur) < abs(lonul - lonur)) lonul = lonul - 360._r8 + if (abs(lonll + 360._r8 - lonur) < abs(lonll - lonur)) lonll = lonll + 360._r8 + if (abs(lonll - 360._r8 - lonur) < abs(lonll - lonur)) lonll = lonll - 360._r8 + if (abs(lonlr + 360._r8 - lonur) < abs(lonlr - lonur)) lonlr = lonlr + 360._r8 + if (abs(lonlr - 360._r8 - lonur) < abs(lonlr - lonur)) lonlr = lonlr - 360._r8 + + nodeCoords(2*n-1) = 0.25_r8 * (lonur + lonul + lonll + lonlr) + nodeCoords(2*n) = 0.25_r8 * (latG(iur) + latG(iul) + latG(ill) + latG(ilr)) + enddo + + deallocate(lonG) + deallocate(latG) + + ! Determine the pes that own each index of iurpts (nodeOwners) + + allocate(pes_local(nx_global*ny_global)) + allocate(pes_global(nx_global*ny_global)) + pes_local(:) = 0 + do n = 1,lsize + pes_local(gindex(n)) = iam + end do + + call ESMF_VMAllReduce(vm, sendData=pes_local, recvData=pes_global, count=nx_global*ny_global, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1,numNodes + nodeOwners(n) = pes_global(iurpts(n)) + end do + deallocate(pes_local) + deallocate(pes_global) + + ! do n = 1,numtotelems + ! write(tmpstr,'(2a,2i8,2g13.6)') subname,' elemA = ',n,elemIds(n),elemCoords(2*n-1:2*n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! write(tmpstr,'(2a,6i8)') subname,' elemB = ',n,elemIds(n),nodeIds(elemConn(4*n-3)),& + ! nodeIds(elemConn(4*n-2)),nodeIds(elemConn(4*n-1)),nodeIds(elemConn(4*n)) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! enddo + ! do n = 1,numNodes + ! write(tmpstr,'(2a,3i8,2g13.6)') subname,' nodesA = ',n,nodeIds(n),nodeOwners(n),nodeCoords(2*n-1:2*n) + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + ! enddo + + Emesh = ESMF_MeshCreate(parametricDim=2, & + spatialDim=2, & + coordSys=ESMF_COORDSYS_SPH_DEG, & + nodeIds=nodeIds(1:numNodes), & + nodeCoords=nodeCoords, & + nodeOwners=nodeOwners, & + elementIds=elemIds,& + elementTypes=elemTypes, & + elementConn=elemConn, & + elementCoords=elemCoords, & + rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + deallocate(iurpts) + deallocate(nodeIds, nodeCoords, nodeOwners) + deallocate(elemIds, elemTypes, elemConn, elemCoords) + + end subroutine shr_nuopc_grid_MeshInit + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_grid_ArrayToState(array, rList, state, grid_option, rc) + + ! copy array data to state fields + use ESMF , only : ESMF_State, ESMF_Field, ESMF_SUCCESS + use ESMF , only : ESMF_LogWrite, ESMF_FieldGet, ESMF_StateGet + use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet + use shr_kind_mod , only : R8=>shr_kind_r8, CS=>shr_kind_cs, IN=>shr_kind_in + use shr_string_mod , only : shr_string_listGetName, shr_string_listGetNum + use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_reset + use med_constants_mod , only : CL, logunit => shr_log_unit + + !----- arguments ----- + real(r8) , intent(inout) :: array(:,:) + character(len=*) , intent(in) :: rList + type(ESMF_State) , intent(inout) :: state + character(len=*) , intent(in) :: grid_option + integer , intent(out) :: rc + + !----- local ----- + type(ESMF_VM) :: vm + integer :: localpet + integer(IN) :: nflds, lsize, n, nf + character(len=CS) :: fldname + type(ESMF_Field) :: lfield + real(R8), pointer :: farray1(:) + integer :: dbrc + character(len=CL) :: tmpstr + character(*),parameter :: subName = "(shr_nuopc_grid_ArrayToState)" + !---------------------------------------------------------- + + rc = ESMF_SUCCESS + call shr_nuopc_methods_State_reset(state, value = 0.0_r8, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGetCurrent(vm, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=localPet, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + lsize = size(array, dim=2) + nflds = shr_string_listGetNum(rList) + do nf = 1,nflds + call shr_string_listGetName(rList, nf, fldname, dbrc) + + call ESMF_StateGet(state, itemName=trim(fldname), field=lfield, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) then + ! we don't nessesarily want this message to trigger an ESMF error + if(localpet==0) write(logunit,*) trim(subname)//": fldname = "//trim(fldname)//" not found on state" + else + call ESMF_LogWrite(trim(subname)//": fldname = "//trim(fldname)//" copy", ESMF_LOGMSG_INFO, rc=dbrc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=farray1, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1,lsize + farray1(n) = array(nf,n) + enddo +#ifdef DEBUG + write(tmpstr,'(a,3g13.6)') trim(subname)//":"//trim(fldname)//"=",minval(farray1),maxval(farray1),sum(farray1) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return +#endif + end if + enddo + + end subroutine shr_nuopc_grid_ArrayToState + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_grid_StateToArray(state, array, rList, grid_option, rc) + + ! copy state fields to array data + use ESMF , only : ESMF_State, ESMF_Field + use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_LogFoundError, ESMF_LogWrite + use ESMF , only : ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet + use shr_kind_mod , only : R8=>shr_kind_r8, CS=>shr_kind_CS, IN=>shr_kind_in + use shr_string_mod , only : shr_string_listGetName, shr_string_listGetNum + use med_constants_mod , only : CL, logunit => shr_log_unit + + + !----- arguments ----- + type(ESMF_State) , intent(in) :: state + real(r8) , intent(inout) :: array(:,:) + character(len=*) , intent(in) :: rList + character(len=*) , intent(in) :: grid_option + integer , intent(out) :: rc + + !----- local ----- + type(ESMF_VM) :: vm + integer :: localpet + integer(IN) :: nflds, lsize, n, nf + character(len=CS) :: fldname + type(ESMF_Field) :: lfield + real(R8), pointer :: farray1(:) + integer :: dbrc + character(len=CL) :: tmpstr + character(*),parameter :: subName = "(shr_nuopc_grid_StateToArray)" + !---------------------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_VMGetCurrent(vm, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=localPet, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + nflds = shr_string_listGetNum(rList) + lsize = size(array, dim=2) + + do nf = 1,nflds + call shr_string_listGetName(rList, nf, fldname, dbrc) + call ESMF_StateGet(state, itemName=trim(fldname), field=lfield, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) then + ! we don't nessesarily want this message to trigger an ESMF error + if(localpet==0) write(logunit,*) trim(subname)//": fldname = "//trim(fldname)//" not found on state" + else + call ESMF_LogWrite(trim(subname)//": fldname = "//trim(fldname)//" copy", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_FieldGet(lfield, farrayPtr=farray1, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + do n = 1,lsize + array(nf,n) = farray1(n) + enddo + write(tmpstr,'(a,3g13.6)') trim(subname)//":"//trim(fldname)//"=",& + minval(farray1),maxval(farray1),sum(farray1) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + endif + + enddo + + end subroutine shr_nuopc_grid_StateToArray + +end module shr_nuopc_grid_mod diff --git a/src/shr/shr_nuopc_methods_mod.F90 b/src/shr/shr_nuopc_methods_mod.F90 new file mode 100644 index 00000000..9edd2beb --- /dev/null +++ b/src/shr/shr_nuopc_methods_mod.F90 @@ -0,0 +1,3626 @@ +module shr_nuopc_methods_mod + + !----------------------------------------------------------------------------- + ! Generic operation methods used by the Mediator Component. + !----------------------------------------------------------------------------- + + use ESMF , only : operator(<), operator(/=), operator(+), operator(-), operator(*) , operator(>=) + use ESMF , only : operator(<=), operator(>), operator(==) + use ESMF , only : ESMF_GeomType_Flag, ESMF_FieldStatus_Flag, ESMF_PoleMethod_Flag + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_LOGERR_PASSTHRU, ESMF_LogFoundError, ESMF_LOGMSG_ERROR + use ESMF , only : ESMF_MAXSTR, ESMF_LOGMSG_WARNING, ESMF_POLEMETHOD_ALLAVG + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + + use shr_nuopc_utils_mod, only : shr_nuopc_methods_ChkErr => shr_nuopc_utils_ChkErr, shr_nuopc_utils_ChkErr + implicit none + private + + interface shr_nuopc_methods_FB_accum ; module procedure & + shr_nuopc_methods_FB_accumFB2FB, & + shr_nuopc_methods_FB_accumFB2ST, & + shr_nuopc_methods_FB_accumST2FB + end interface + + interface shr_nuopc_methods_FB_copy ; module procedure & + shr_nuopc_methods_FB_copyFB2FB, & + shr_nuopc_methods_FB_copyFB2ST, & + shr_nuopc_methods_FB_copyST2FB + end interface + + interface shr_nuopc_methods_FieldPtr_compare ; module procedure & + shr_nuopc_methods_FieldPtr_compare1, & + shr_nuopc_methods_FieldPtr_compare2 + end interface + + interface shr_nuopc_methods_UpdateTimestamp; module procedure & + shr_nuopc_methods_State_UpdateTimestamp, & + shr_nuopc_methods_Field_UpdateTimestamp + end interface + + ! used/reused in module + + logical :: isPresent + character(len=1024) :: msgString + type(ESMF_GeomType_Flag) :: geomtype + type(ESMF_FieldStatus_Flag) :: status + character(*) , parameter :: u_FILE_u = & + __FILE__ + + public shr_nuopc_methods_FB_copy + public shr_nuopc_methods_FB_accum + public shr_nuopc_methods_FB_average + public shr_nuopc_methods_FB_init + public shr_nuopc_methods_FB_reset + public shr_nuopc_methods_FB_clean + public shr_nuopc_methods_FB_diagnose + public shr_nuopc_methods_FB_FldChk + public shr_nuopc_methods_FB_GetFldPtr + public shr_nuopc_methods_FB_getNameN + public shr_nuopc_methods_FB_getFieldN + public shr_nuopc_methods_FB_Field_diagnose + public shr_nuopc_methods_FB_FieldRegrid + public shr_nuopc_methods_FB_getNumflds + public shr_nuopc_methods_State_reset + public shr_nuopc_methods_State_diagnose + public shr_nuopc_methods_State_GeomPrint + public shr_nuopc_methods_State_GeomWrite + public shr_nuopc_methods_State_GetFldPtr + public shr_nuopc_methods_State_SetScalar + public shr_nuopc_methods_State_GetScalar + public shr_nuopc_methods_State_GetNumFields + public shr_nuopc_methods_State_getFieldN + public shr_nuopc_methods_State_FldDebug + public shr_nuopc_methods_Field_GeomPrint + public shr_nuopc_methods_Clock_TimePrint + public shr_nuopc_methods_UpdateTimestamp + public shr_nuopc_methods_ChkErr + public shr_nuopc_methods_Distgrid_Match + public shr_nuopc_methods_Print_FieldExchInfo + public shr_nuopc_methods_FieldPtr_compare + public shr_nuopc_methods_States_GetSharedFlds + + private shr_nuopc_methods_Grid_Write + private shr_nuopc_methods_Grid_Print + private shr_nuopc_methods_Mesh_Print + private shr_nuopc_methods_Mesh_Write + private shr_nuopc_methods_Field_GetFldPtr + private shr_nuopc_methods_Field_GeomWrite + private shr_nuopc_methods_Field_UpdateTimestamp + private shr_nuopc_methods_FB_GeomPrint + private shr_nuopc_methods_FB_GeomWrite + private shr_nuopc_methods_FB_RWFields + private shr_nuopc_methods_FB_getFieldByName + private shr_nuopc_methods_FB_SetFldPtr + private shr_nuopc_methods_FB_copyFB2FB + private shr_nuopc_methods_FB_copyFB2ST + private shr_nuopc_methods_FB_copyST2FB + private shr_nuopc_methods_FB_accumFB2FB + private shr_nuopc_methods_FB_accumST2FB + private shr_nuopc_methods_FB_accumFB2ST + private shr_nuopc_methods_State_UpdateTimestamp + private shr_nuopc_methods_State_getNameN + private shr_nuopc_methods_State_getFieldByName + private shr_nuopc_methods_State_SetFldPtr + private shr_nuopc_methods_Array_diagnose + + !----------------------------------------------------------------------------- + contains + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_RWFields(mode,fname,FB,flag,rc) + ! ---------------------------------------------- + ! Read or Write Field Bundles + ! ---------------------------------------------- + use ESMF, only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_FieldBundleWrite + use ESMF, only : ESMF_FieldRead, ESMF_IOFMT_NETCDF, ESMF_FILESTATUS_REPLACE + + character(len=*) :: mode + character(len=*) :: fname + type(ESMF_FieldBundle) :: FB + logical,optional :: flag + integer,optional :: rc + + ! local variables + type(ESMF_Field) :: field + character(len=ESMF_MAXSTR) :: name + integer :: fieldcount, n + logical :: fexists + integer :: dbrc + character(len=*), parameter :: subname='(shr_nuopc_methods_FB_RWFields)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//trim(fname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + if (mode == 'write') then + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": write "//trim(fname), ESMF_LOGMSG_INFO, rc=dbrc) + end if + call ESMF_FieldBundleWrite(FB, fname, & + singleFile=.true., status=ESMF_FILESTATUS_REPLACE, iofmt=ESMF_IOFMT_NETCDF, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_diagnose(FB, 'write '//trim(fname), rc) + + elseif (mode == 'read') then + inquire(file=fname,exist=fexists) + if (fexists) then + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": read "//trim(fname), ESMF_LOGMSG_INFO, rc=dbrc) + end if + !----------------------------------------------------------------------------------------------------- + ! tcraig, ESMF_FieldBundleRead fails if a field is not on the field bundle, but we really want to just + ! ignore that field and read the rest, so instead read each field one at a time through ESMF_FieldRead + ! call ESMF_FieldBundleRead (FB, fname, & + ! singleFile=.true., iofmt=ESMF_IOFMT_NETCDF, rc=rc) + ! if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + !----------------------------------------------------------------------------------------------------- + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,fieldCount + call shr_nuopc_methods_FB_getFieldByName(FB, name, field, rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRead (field, fname, iofmt=ESMF_IOFMT_NETCDF, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=u_FILE_u)) call ESMF_LogWrite(trim(subname)//' WARNING missing field '//trim(name),rc=dbrc) + enddo + + call shr_nuopc_methods_FB_diagnose(FB, 'read '//trim(fname), rc) + if (present(flag)) flag = .true. + endif + + else + call ESMF_LogWrite(trim(subname)//": mode WARNING "//trim(fname)//" mode="//trim(mode), ESMF_LOGMSG_INFO, rc=dbrc) + endif + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//trim(fname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_FB_RWFields + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, STgeom, FBflds, STflds, name, rc) + + use ESMF , only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleCreate, ESMF_FieldBundleGet + use ESMF , only : ESMF_State, ESMF_Grid, ESMF_Mesh, ESMF_StaggerLoc, ESMF_MeshLoc + use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_FieldBundleAdd, ESMF_FieldCreate + use ESMF , only : ESMF_TYPEKIND_R8, ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID + use ESMF , only : ESMF_FIELDSTATUS_EMPTY + use med_constants_mod , only : spval_init => med_constants_spval_init + + ! ---------------------------------------------- + ! Create FBout from fieldNameList, FBflds, STflds, FBgeom or STgeom in that order or priority + ! Pass in FBgeom OR STgeom, get grid/mesh from that object + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_FieldBundle), intent(inout) :: FBout + character(len=*) , intent(in) :: flds_scalar_name + character(len=*) , intent(in), optional :: fieldNameList(:) + type(ESMF_FieldBundle), intent(in), optional :: FBgeom + type(ESMF_State) , intent(in), optional :: STgeom + type(ESMF_FieldBundle), intent(in), optional :: FBflds + type(ESMF_State) , intent(in), optional :: STflds + character(len=*) , intent(in), optional :: name + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n,n1 + integer :: fieldCount,fieldCountgeom + logical :: found + character(ESMF_MAXSTR) :: lname + type(ESMF_Field) :: field,lfield + type(ESMF_Grid) :: lgrid + type(ESMF_Mesh) :: lmesh + type(ESMF_StaggerLoc) :: staggerloc + type(ESMF_MeshLoc) :: meshloc + integer :: dbrc + character(ESMF_MAXSTR),allocatable :: lfieldNameList(:) + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_init)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + lname = 'undefined' + if (present(name)) then + lname = trim(name) + endif + lname = 'FB '//trim(lname) + + !--------------------------------- + ! check argument consistency and + ! verify that geom argument has a field + !--------------------------------- + + if (present(fieldNameList) .and. present(FBflds) .and. present(STflds)) then + call ESMF_LogWrite(trim(subname)//": ERROR only fieldNameList, FBflds, or STflds can be an argument", & + ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + endif + + if (present(FBgeom) .and. present(STgeom)) then + call ESMF_LogWrite(trim(subname)//": ERROR FBgeom and STgeom cannot both be arguments", & + ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + endif + + if (.not.present(FBgeom) .and. .not.present(STgeom)) then + call ESMF_LogWrite(trim(subname)//": ERROR FBgeom or STgeom must be an argument", & + ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + endif + + if (present(FBgeom)) then + call ESMF_FieldBundleGet(FBgeom, fieldCount=fieldCountGeom, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + elseif (present(STgeom)) then + call ESMF_StateGet(STgeom, itemCount=fieldCountGeom, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//": ERROR FBgeom or STgeom must be passed", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + endif + + !--------------------------------- + ! determine the names of fields that will be in FBout + !--------------------------------- + + if (present(fieldNameList)) then + fieldcount = size(fieldNameList) + allocate(lfieldNameList(fieldcount)) + lfieldNameList = fieldNameList + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from argument", ESMF_LOGMSG_INFO, rc=rc) + end if + elseif (present(FBflds)) then + call ESMF_FieldBundleGet(FBflds, fieldCount=fieldCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldNameList(fieldCount)) + call ESMF_FieldBundleGet(FBflds, fieldNameList=lfieldNameList, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from FBflds", ESMF_LOGMSG_INFO, rc=rc) + end if + elseif (present(STflds)) then + call ESMF_StateGet(STflds, itemCount=fieldCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldNameList(fieldCount)) + call ESMF_StateGet(STflds, itemNameList=lfieldNameList, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from STflds", ESMF_LOGMSG_INFO, rc=rc) + end if + elseif (present(FBgeom)) then + call ESMF_FieldBundleGet(FBgeom, fieldCount=fieldCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldNameList(fieldCount)) + call ESMF_FieldBundleGet(FBgeom, fieldNameList=lfieldNameList, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from FBgeom", ESMF_LOGMSG_INFO, rc=rc) + end if + elseif (present(STgeom)) then + call ESMF_StateGet(STgeom, itemCount=fieldCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldNameList(fieldCount)) + call ESMF_StateGet(STgeom, itemNameList=lfieldNameList, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from STflds", ESMF_LOGMSG_INFO, rc=rc) + end if + else + call ESMF_LogWrite(trim(subname)//": ERROR fieldNameList, FBflds, STflds, FBgeom, or STgeom must be passed", & + ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + endif + + !--------------------------------- + ! remove scalar field and blank fields from field bundle + !--------------------------------- + + do n = 1, fieldCount + if (trim(lfieldnamelist(n)) == trim(flds_scalar_name) .or. & + trim(lfieldnamelist(n)) == '') then + do n1 = n, fieldCount-1 + lfieldnamelist(n1) = lfieldnamelist(n1+1) + enddo + fieldCount = fieldCount - 1 + endif + enddo ! n + + !--------------------------------- + ! create the grid (lgrid) or mesh(lmesh) + ! that will be used for FBout fields + !--------------------------------- + + if (fieldcount > 0 .and. fieldcountgeom > 0) then + + ! Look at only the first field in either the FBgeom and STgeom to get the grid + if (present(FBgeom)) then + call shr_nuopc_methods_FB_getFieldN(FBgeom, 1, lfield, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" grid/mesh from FBgeom", ESMF_LOGMSG_INFO, rc=rc) + end if + elseif (present(STgeom)) then + call shr_nuopc_methods_State_getFieldN(STgeom, 1, lfield, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" grid/mesh from STgeom", ESMF_LOGMSG_INFO, rc=rc) + end if + else + call ESMF_LogWrite(trim(subname)//": ERROR FBgeom or STgeom must be passed", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + endif + + ! Make sure the field is not empty - if it is return with an error + call ESMF_FieldGet(lfield, status=status, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (status == ESMF_FIELDSTATUS_EMPTY) then + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//": ERROR field does not have a geom yet ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + ! Determine if first field in either FBgeom or STgeom is on a grid or a mesh + call ESMF_FieldGet(lfield, geomtype=geomtype, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_FieldGet(lfield, grid=lgrid, staggerloc=staggerloc, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" use grid", ESMF_LOGMSG_INFO, rc=rc) + end if + elseif (geomtype == ESMF_GEOMTYPE_MESH) then + call ESMF_FieldGet(lfield, mesh=lmesh, meshloc=meshloc, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" use mesh", ESMF_LOGMSG_INFO, rc=rc) + end if + else ! geomtype + call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + endif ! geomtype + + endif ! fieldcount > 0 + + !--------------------------------- + ! create FBout + !--------------------------------- + + FBout = ESMF_FieldBundleCreate(name=trim(lname), rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (fieldcountgeom > 0) then + + ! Now loop over all the fields in either FBgeom or STgeom + do n = 1, fieldCount + + ! Create the field on either lgrid or lmesh + if (geomtype == ESMF_GEOMTYPE_GRID) then + field = ESMF_FieldCreate(lgrid, ESMF_TYPEKIND_R8, staggerloc=staggerloc, name=lfieldNameList(n), rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + elseif (geomtype == ESMF_GEOMTYPE_MESH) then + field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + else ! geomtype + call ESMF_LogWrite(trim(subname)//": ERROR no grid/mesh for field ", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + endif + + ! Add the created field bundle FBout + call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" adding field "//trim(lfieldNameList(n)), & + ESMF_LOGMSG_INFO, rc=dbrc) + endif + + enddo ! fieldCount + + endif ! fieldcountgeom + + deallocate(lfieldNameList) + + call shr_nuopc_methods_FB_reset(FBout, value=spval_init, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_FB_init + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_getNameN(FB, fieldnum, fieldname, rc) + use ESMF, only : ESMF_FieldBundle, ESMF_FieldBundleGet + ! ---------------------------------------------- + ! Get name of field number fieldnum in FB + ! ---------------------------------------------- + type(ESMF_FieldBundle), intent(in) :: FB + integer , intent(in) :: fieldnum + character(len=*) , intent(out) :: fieldname + integer , intent(out) :: rc + + ! local variables + integer :: fieldCount + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_getNameN)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + fieldname = ' ' + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (fieldnum > fieldCount) then + call ESMF_LogWrite(trim(subname)//": ERROR fieldnum > fieldCount ", ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + allocate(lfieldnamelist(fieldCount)) + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + fieldname = lfieldnamelist(fieldnum) + + deallocate(lfieldnamelist) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_FB_getNameN + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_getFieldN(FB, fieldnum, field, rc) + use ESMF, only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleGet + + ! ---------------------------------------------- + ! Get field number fieldnum out of FB + ! ---------------------------------------------- + type(ESMF_FieldBundle), intent(in) :: FB + integer , intent(in) :: fieldnum + type(ESMF_Field) , intent(inout) :: field + integer , intent(out) :: rc + + ! local variables + character(len=ESMF_MAXSTR) :: name + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_getFieldN)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + call shr_nuopc_methods_FB_getNameN(FB, fieldnum, name, rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(FB, fieldName=name, field=field, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_FB_getFieldN + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_getFieldByName(FB, fieldname, field, rc) + use ESMF, only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleGet + ! ---------------------------------------------- + ! Get field associated with fieldname out of FB + ! ---------------------------------------------- + type(ESMF_FieldBundle), intent(in) :: FB + character(len=*) , intent(in) :: fieldname + type(ESMF_Field) , intent(inout) :: field + integer , intent(out) :: rc + + ! local variables + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_getFieldByName)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + call ESMF_FieldBundleGet(FB, fieldName=fieldname, field=field, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_FB_getFieldByName + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_getNameN(State, fieldnum, fieldname, rc) + use ESMF, only : ESMF_State, ESMF_StateGet + ! ---------------------------------------------- + ! Get field number fieldnum name out of State + ! ---------------------------------------------- + type(ESMF_State), intent(in) :: State + integer , intent(in) :: fieldnum + character(len=*), intent(out) :: fieldname + integer , intent(out) :: rc + + ! local variables + integer :: fieldCount + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_State_getNameN)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + fieldname = ' ' + + call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (fieldnum > fieldCount) then + call ESMF_LogWrite(trim(subname)//": ERROR fieldnum > fieldCount ", ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + allocate(lfieldnamelist(fieldCount)) + call ESMF_StateGet(State, itemNameList=lfieldnamelist, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + fieldname = lfieldnamelist(fieldnum) + + deallocate(lfieldnamelist) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_State_getNameN + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_getNumFields(State, fieldnum, rc) + use NUOPC , only : NUOPC_GetStateMemberLists + use ESMF , only : ESMF_State, ESMF_Field, ESMF_StateGet, ESMF_STATEITEM_FIELD + use ESMF , only : ESMF_StateItem_Flag + ! ---------------------------------------------- + ! Get field number fieldnum name out of State + ! ---------------------------------------------- + type(ESMF_State), intent(in) :: State + integer , intent(inout) :: fieldnum + integer , intent(out) :: rc + + ! local variables + integer :: n,itemCount + type(ESMF_Field), pointer :: fieldList(:) + type(ESMF_StateItem_Flag), pointer :: itemTypeList(:) + logical, parameter :: use_NUOPC_method = .true. + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_State_getNumFields)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + if (use_NUOPC_method) then + + nullify(fieldList) + call NUOPC_GetStateMemberLists(state, fieldList=fieldList, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + fieldnum = 0 + if (associated(fieldList)) then + fieldnum = size(fieldList) + deallocate(fieldList) + endif + + else + + fieldnum = 0 + call ESMF_StateGet(State, itemCount=itemCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (itemCount > 0) then + allocate(itemTypeList(itemCount)) + call ESMF_StateGet(State, itemTypeList=itemTypeList, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1,itemCount + if (itemTypeList(n) == ESMF_STATEITEM_FIELD) fieldnum=fieldnum+1 + enddo + deallocate(itemTypeList) + endif + + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_State_getNumFields + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_getFieldN(State, fieldnum, field, rc) + use ESMF, only : ESMF_State, ESMF_Field, ESMF_StateGet + ! ---------------------------------------------- + ! Get field number fieldnum in State + ! ---------------------------------------------- + type(ESMF_State), intent(in) :: State + integer , intent(in) :: fieldnum + type(ESMF_Field), intent(inout) :: field + integer , intent(out) :: rc + + ! local variables + character(len=ESMF_MAXSTR) :: name + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_State_getFieldN)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + call shr_nuopc_methods_State_getNameN(State, fieldnum, name, rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(State, itemName=name, field=field, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_State_getFieldN + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_getFieldByName(State, fieldname, field, rc) + ! ---------------------------------------------- + ! Get field associated with fieldname from State + ! ---------------------------------------------- + use ESMF, only : ESMF_State, ESMF_Field, ESMF_StateGet + + type(ESMF_State), intent(in) :: State + character(len=*), intent(in) :: fieldname + type(ESMF_Field), intent(inout) :: field + integer , intent(out) :: rc + + ! local variables + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_State_getFieldByName)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + call ESMF_StateGet(State, itemName=fieldname, field=field, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_State_getFieldByName + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_clean(FB, rc) + ! ---------------------------------------------- + ! Destroy fields in FB and FB + ! ---------------------------------------------- + use med_constants_mod, only : R8 + use ESMF, only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_FieldDestroy + use ESMF, only : ESMF_FieldBundleDestroy, ESMF_Field + + type(ESMF_FieldBundle), intent(inout) :: FB + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + type(ESMF_Field) :: field + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_clean)' + ! ---------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + rc = ESMF_SUCCESS + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + call ESMF_FieldBundleGet(FB, fieldName=lfieldnamelist(n), field=field, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldDestroy(field, rc=rc, noGarbage=.true.) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + enddo + + call ESMF_FieldBundleDestroy(FB, rc=rc, noGarbage=.true.) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(lfieldnamelist) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + + end subroutine shr_nuopc_methods_FB_clean + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_reset(FB, value, rc) + ! ---------------------------------------------- + ! Set all fields to value in FB + ! If value is not provided, reset to 0.0 + ! ---------------------------------------------- + use med_constants_mod , only : czero => med_constants_czero + use med_constants_mod , only : R8 + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet + + type(ESMF_FieldBundle), intent(inout) :: FB + real(R8) , intent(in), optional :: value + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + real(R8) :: lvalue + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_reset)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + lvalue = czero + if (present(value)) then + lvalue = value + endif + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + call shr_nuopc_methods_FB_SetFldPtr(FB, lfieldnamelist(n), lvalue, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + enddo + + deallocate(lfieldnamelist) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_FB_reset + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_FieldRegrid(FBin,fldin,FBout,fldout,RH,rc,zeroregion) + + ! ---------------------------------------------- + ! Regrid a field in a field bundle to another field in a field bundle + ! ---------------------------------------------- + + use ESMF , only : ESMF_FieldBundle, ESMF_RouteHandle, ESMF_FieldRegrid, ESMF_Field + use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_FieldRegridStore, ESMF_SparseMatrixWrite + use ESMF , only : ESMF_Region_Flag, ESMF_REGION_TOTAL + use med_constants_mod , only : R8 + use perf_mod , only : t_startf, t_stopf + + type(ESMF_FieldBundle), intent(in) :: FBin + character(len=*) , intent(in) :: fldin + type(ESMF_FieldBundle), intent(inout) :: FBout + character(len=*) , intent(in) :: fldout + type(ESMF_RouteHandle), intent(inout) :: RH + integer , intent(out) :: rc + type(ESMF_Region_Flag), intent(in), optional :: zeroregion + + ! local + real(R8), pointer :: factorList(:) + integer, pointer :: factorIndexList(:,:) + type(ESMF_Field) :: field1, field2 + integer :: dbrc + integer :: rank + logical :: checkflag = .false. + character(len=8) :: filename + type(ESMF_Region_Flag) :: localzr + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_FieldRegrid)' + ! ---------------------------------------------- +#ifdef DEBUG + checkflag = .true. +#endif + call t_startf(subname) + rc = ESMF_SUCCESS + + localzr = ESMF_REGION_TOTAL + if (present(zeroregion)) then + localzr = zeroregion + endif + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + + if (shr_nuopc_methods_FB_FldChk(FBin , trim(fldin) , rc=rc) .and. & + shr_nuopc_methods_FB_FldChk(FBout, trim(fldout), rc=rc)) then + + call shr_nuopc_methods_FB_getFieldByName(FBin, trim(fldin), field1, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_getFieldByName(FBout, trim(fldout), field2, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldRegrid(field1, field2, routehandle=RH, & + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, & + zeroregion=localzr, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//" field not found: "//& + trim(fldin)//","//trim(fldout), ESMF_LOGMSG_INFO, rc=dbrc) + endif + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call t_stopf(subname) + + end subroutine shr_nuopc_methods_FB_FieldRegrid + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_reset(State, value, rc) + + ! ---------------------------------------------- + ! Set all fields to value in State + ! If value is not provided, reset to 0.0 + ! ---------------------------------------------- + use med_constants_mod , only : czero => med_constants_czero + use med_constants_mod , only : R8 + use ESMF , only : ESMF_State, ESMF_StateGet + + type(ESMF_State) , intent(inout) :: State + real(R8) , intent(in), optional :: value + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + real(R8) :: lvalue + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_State_reset)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + lvalue = czero + if (present(value)) then + lvalue = value + endif + + call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + call ESMF_StateGet(State, itemNameList=lfieldnamelist, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + call shr_nuopc_methods_State_SetFldPtr(State, lfieldnamelist(n), lvalue, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + enddo + + deallocate(lfieldnamelist) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_State_reset + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_average(FB, count, rc) + ! ---------------------------------------------- + ! Set all fields to zero in FB + ! ---------------------------------------------- + use med_constants_mod , only : R8 + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet + + type(ESMF_FieldBundle), intent(inout) :: FB + integer , intent(in) :: count + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount, lrank + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + real(R8), pointer :: dataPtr1(:) + real(R8), pointer :: dataPtr2(:,:) + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_average)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + if (count == 0) then + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": WARNING count is 0", ESMF_LOGMSG_INFO, rc=dbrc) + end if + !call ESMF_LogWrite(trim(subname)//": WARNING count is 0 set avg to spval", ESMF_LOGMSG_INFO, rc=dbrc) + !call shr_nuopc_methods_FB_reset(FB, value=spval, rc=rc) + !if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + else + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1, fieldCount + call shr_nuopc_methods_FB_GetFldPtr(FB, lfieldnamelist(n), dataPtr1, dataPtr2, lrank, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + do i=lbound(dataptr1,1),ubound(dataptr1,1) + dataptr1(i) = dataptr1(i) / real(count, R8) + enddo + elseif (lrank == 2) then + do j=lbound(dataptr2,2),ubound(dataptr2,2) + do i=lbound(dataptr2,1),ubound(dataptr2,1) + dataptr2(i,j) = dataptr2(i,j) / real(count, R8) + enddo + enddo + else + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + enddo + deallocate(lfieldnamelist) + + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_FB_average + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_diagnose(FB, string, rc) + ! ---------------------------------------------- + ! Diagnose status of FB + ! ---------------------------------------------- + + use med_constants_mod , only : R8, CL + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet + + type(ESMF_FieldBundle) , intent(inout) :: FB + character(len=*) , intent(in), optional :: string + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount, lrank + character(ESMF_MAXSTR), pointer :: lfieldnamelist(:) + character(len=CL) :: lstring + real(R8), pointer :: dataPtr1d(:) + real(R8), pointer :: dataPtr2d(:,:) + integer :: dbrc + character(len=*), parameter :: subname='(shr_nuopc_methods_FB_diagnose)' + ! ---------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + rc = ESMF_SUCCESS + + lstring = '' + if (present(string)) then + lstring = trim(string) // ' ' + endif + + ! Determine number of fields in field bundle and allocate memory for lfieldnamelist + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + + ! Get the fields in the field bundle + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! For each field in the bundle, get its memory location and print out the field + do n = 1, fieldCount + call shr_nuopc_methods_FB_GetFldPtr(FB, lfieldnamelist(n), & + fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + + elseif (lrank == 1) then + if (size(dataPtr1d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n))//' ', & + minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), " no data" + endif + + elseif (lrank == 2) then + if (size(dataPtr2d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n))//' ', & + minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & + " no data" + endif + + else + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR, & + line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + enddo + + ! Deallocate memory + deallocate(lfieldnamelist) + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + + end subroutine shr_nuopc_methods_FB_diagnose + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_Array_diagnose(array, string, rc) + + ! ---------------------------------------------- + ! Diagnose status of Array + ! ---------------------------------------------- + + use med_constants_mod, only : R8, CS + use ESMF, only : ESMF_Array, ESMF_ArrayGet + + ! input/output variables + type(ESMF_Array), intent(inout) :: array + character(len=*), intent(in), optional :: string + integer , intent(out) :: rc + + ! local variables + character(len=CS) :: lstring + real(R8), pointer :: dataPtr3d(:,:,:) + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_Array_diagnose)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + ! this is not working yet, not sure about dataPtr dim/type + return + + lstring = '' + if (present(string)) then + lstring = trim(string) + endif + + call ESMF_ArrayGet(Array, farrayPtr=dataPtr3d, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write(msgString,'(A,3g14.7)') trim(subname)//' '//trim(lstring), & + minval(dataPtr3d), maxval(dataPtr3d), sum(dataPtr3d) + + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + end if + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_Array_diagnose + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_diagnose(State, string, rc) + ! ---------------------------------------------- + ! Diagnose status of State + ! ---------------------------------------------- + use med_constants_mod, only : R8, CS + use ESMF, only : ESMF_State, ESMF_StateGet + + type(ESMF_State), intent(in) :: State + character(len=*), intent(in), optional :: string + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount, lrank + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + character(len=CS) :: lstring + real(R8), pointer :: dataPtr1d(:) + real(R8), pointer :: dataPtr2d(:,:) + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_State_diagnose)' + ! ---------------------------------------------- + + if (dbug_flag > 5) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + endif + + lstring = '' + if (present(string)) then + lstring = trim(string) + endif + + call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + + call ESMF_StateGet(State, itemNameList=lfieldnamelist, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + + call shr_nuopc_methods_State_GetFldPtr(State, lfieldnamelist(n), & + fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + + elseif (lrank == 1) then + if (size(dataPtr1d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & + minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & + " no data" + endif + + elseif (lrank == 2) then + if (size(dataPtr2d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & + minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & + " no data" + endif + + else + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR, line=__LINE__, & + file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + + enddo + + deallocate(lfieldnamelist) + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_State_diagnose + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_Field_diagnose(FB, fieldname, string, rc) + + ! ---------------------------------------------- + ! Diagnose status of State + ! ---------------------------------------------- + + use med_constants_mod, only : R8, CS + use ESMF, only : ESMF_FieldBundle + + ! input/output variables + type(ESMF_FieldBundle), intent(inout) :: FB + character(len=*), intent(in) :: fieldname + character(len=*), intent(in), optional :: string + integer , intent(out) :: rc + + ! local variables + integer :: lrank + character(len=CS) :: lstring + real(R8), pointer :: dataPtr1d(:) + real(R8), pointer :: dataPtr2d(:,:) + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_FieldDiagnose)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + lstring = '' + if (present(string)) then + lstring = trim(string) + endif + + call shr_nuopc_methods_FB_GetFldPtr(FB, fieldname, dataPtr1d, dataPtr2d, lrank, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + if (size(dataPtr1d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname), & + minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname), & + " no data" + endif + elseif (lrank == 2) then + if (size(dataPtr2d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname), & + minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname), & + " no data" + endif + else + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR, line=__LINE__, & + file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_FB_Field_diagnose + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_copyFB2FB(FBout, FBin, rc) + ! ---------------------------------------------- + ! Copy common field names from FBin to FBout + ! ---------------------------------------------- + use ESMF, only : ESMF_FieldBundle + type(ESMF_FieldBundle), intent(inout) :: FBout + type(ESMF_FieldBundle), intent(in) :: FBin + integer , intent(out) :: rc + + integer :: dbrc + character(len=*), parameter :: subname='(shr_nuopc_methods_FB_copyFB2FB)' + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + rc = ESMF_SUCCESS + + call shr_nuopc_methods_FB_accum(FBout, FBin, copy=.true., rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_FB_copyFB2FB + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_copyFB2ST(STout, FBin, rc) + ! ---------------------------------------------- + ! Copy common field names from FBin to STout + ! ---------------------------------------------- + use ESMF, only : ESMF_State, ESMF_FieldBundle + + type(ESMF_State) , intent(inout) :: STout + type(ESMF_FieldBundle), intent(in) :: FBin + integer , intent(out) :: rc + + integer :: dbrc + character(len=*), parameter :: subname='(shr_nuopc_methods_FB_copyFB2ST)' + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + call shr_nuopc_methods_FB_accum(STout, FBin, copy=.true., rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_FB_copyFB2ST + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_copyST2FB(FBout, STin, rc) + ! ---------------------------------------------- + ! Copy common field names from STin to FBout + ! ---------------------------------------------- + use ESMF, only : ESMF_State, ESMF_FieldBundle + + type(ESMF_FieldBundle), intent(inout) :: FBout + type(ESMF_State) , intent(in) :: STin + integer , intent(out) :: rc + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_copyST2FB)' + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + call shr_nuopc_methods_FB_accum(FBout, STin, copy=.true., rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_FB_copyST2FB + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_accumFB2FB(FBout, FBin, copy, rc) + ! ---------------------------------------------- + ! Accumulate common field names from FBin to FBout + ! If copy is passed in and true, the this is a copy + ! ---------------------------------------------- + use med_constants_mod , only : R8 + use ESMF , only : ESMF_FieldBundle + use ESMF , only : ESMF_FieldBundleGet + + type(ESMF_FieldBundle), intent(inout) :: FBout + type(ESMF_FieldBundle), intent(in) :: FBin + logical, optional , intent(in) :: copy + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount, lranki, lranko + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + logical :: exists + logical :: lcopy + real(R8), pointer :: dataPtri1(:) , dataPtro1(:) + real(R8), pointer :: dataPtri2(:,:), dataPtro2(:,:) + integer :: dbrc + character(len=*), parameter :: subname='(shr_nuopc_methods_FB_accumFB2FB)' + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + lcopy = .false. ! accumulate by default + if (present(copy)) then + lcopy = copy + endif + + call ESMF_FieldBundleGet(FBout, fieldCount=fieldCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + call ESMF_FieldBundleGet(FBout, fieldNameList=lfieldnamelist, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + call ESMF_FieldBundleGet(FBin, fieldName=lfieldnamelist(n), isPresent=exists, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (exists) then + call shr_nuopc_methods_FB_GetFldPtr(FBin, lfieldnamelist(n), dataPtri1, dataPtri2, lranki, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBout, lfieldnamelist(n), dataPtro1, dataPtro2, lranko, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (lranki == 1 .and. lranko == 1) then + + if (.not.shr_nuopc_methods_FieldPtr_Compare(dataPtro1, dataPtri1, subname, rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr1 size ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) + rc = ESMF_FAILURE + return + endif + + if (lcopy) then + do i=lbound(dataPtri1,1),ubound(dataPtri1,1) + dataPtro1(i) = dataPtri1(i) + enddo + else + do i=lbound(dataPtri1,1),ubound(dataPtri1,1) + dataPtro1(i) = dataPtro1(i) + dataPtri1(i) + enddo + endif + + elseif (lranki == 2 .and. lranko == 2) then + + if (.not.shr_nuopc_methods_FieldPtr_Compare(dataPtro2, dataPtri2, subname, rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr2 size ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) + rc = ESMF_FAILURE + return + endif + + if (lcopy) then + do j=lbound(dataPtri2,2),ubound(dataPtri2,2) + do i=lbound(dataPtri2,1),ubound(dataPtri2,1) + dataPtro2(i,j) = dataPtri2(i,j) + enddo + enddo + else + do j=lbound(dataPtri2,2),ubound(dataPtri2,2) + do i=lbound(dataPtri2,1),ubound(dataPtri2,1) + dataPtro2(i,j) = dataPtro2(i,j) + dataPtri2(i,j) + enddo + enddo + endif + + else + + write(msgString,'(a,2i8)') trim(subname)//": ranki, ranko = ",lranki,lranko + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": ERROR ranki ranko not supported "//trim(lfieldnamelist(n)), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + + endif + + endif + enddo + + deallocate(lfieldnamelist) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_FB_accumFB2FB + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_accumST2FB(FBout, STin, copy, rc) + ! ---------------------------------------------- + ! Accumulate common field names from State to FB + ! If copy is passed in and true, the this is a copy + ! ---------------------------------------------- + use med_constants_mod, only : R8 + use ESMF, only : ESMF_State, ESMF_FieldBundle + use ESMF, only : ESMF_StateGet, ESMF_FieldBundleGet + use ESMF, only : ESMF_STATEITEM_NOTFOUND, ESMF_StateItem_Flag + + type(ESMF_FieldBundle), intent(inout) :: FBout + type(ESMF_State) , intent(in) :: STin + logical, optional , intent(in) :: copy + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount, lrankS, lrankB + logical :: lcopy + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + type(ESMF_StateItem_Flag) :: itemType + real(R8), pointer :: dataPtrS1(:) , dataPtrB1(:) + real(R8), pointer :: dataPtrS2(:,:), dataPtrB2(:,:) + integer :: dbrc + character(len=*), parameter :: subname='(shr_nuopc_methods_FB_accumST2FB)' + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + lcopy = .false. + if (present(copy)) then + lcopy = copy + endif + + call ESMF_FieldBundleGet(FBout, fieldCount=fieldCount, rc=rc) + allocate(lfieldnamelist(fieldCount)) + call ESMF_FieldBundleGet(FBout, fieldNameList=lfieldnamelist, rc=rc) + do n = 1, fieldCount + call ESMF_StateGet(STin, itemName=lfieldnamelist(n), itemType=itemType, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (itemType /= ESMF_STATEITEM_NOTFOUND) then + + call shr_nuopc_methods_State_GetFldPtr(STin, lfieldnamelist(n), dataPtrS1, dataPtrS2, lrankS, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBout, lfieldnamelist(n), dataPtrB1, dataPtrB2, lrankB, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (lrankB == 0 .and. lrankS == 0) then + + ! no local data + + elseif (lrankS == 1 .and. lrankB == 1) then + + if (.not.shr_nuopc_methods_FieldPtr_Compare(dataPtrS1, dataPtrB1, subname, rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr1 size ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) + rc = ESMF_FAILURE + return + endif + + if (lcopy) then + do i=lbound(dataPtrB1,1),ubound(dataPtrB1,1) + dataPtrB1(i) = dataPtrS1(i) + enddo + else + do i=lbound(dataPtrB1,1),ubound(dataPtrB1,1) + dataPtrB1(i) = dataPtrB1(i) + dataPtrS1(i) + enddo + endif + + elseif (lrankS == 2 .and. lrankB == 2) then + + if (.not.shr_nuopc_methods_FieldPtr_Compare(dataPtrS2, dataPtrB2, subname, rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr2 size ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) + rc = ESMF_FAILURE + return + endif + + if (lcopy) then + do j=lbound(dataPtrB2,2),ubound(dataPtrB2,2) + do i=lbound(dataPtrB2,1),ubound(dataPtrB2,1) + dataPtrB2(i,j) = dataPtrS2(i,j) + enddo + enddo + else + do j=lbound(dataPtrB2,2),ubound(dataPtrB2,2) + do i=lbound(dataPtrB2,1),ubound(dataPtrB2,1) + dataPtrB2(i,j) = dataPtrB2(i,j) + dataPtrS2(i,j) + enddo + enddo + endif + + else + + write(msgString,'(a,2i8)') trim(subname)//": rankB, ranks = ",lrankB,lrankS + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": ERROR rankB rankS not supported "//trim(lfieldnamelist(n)), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + + endif + + endif ! statefound + enddo ! fieldCount + + deallocate(lfieldnamelist) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_FB_accumST2FB + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_accumFB2ST(STout, FBin, copy, rc) + ! ---------------------------------------------- + ! Accumulate common field names from FB to State + ! If copy is passed in and true, the this is a copy + ! ---------------------------------------------- + use med_constants_mod , only : R8 + use ESMF , only : ESMF_State, ESMF_FieldBundle + use ESMF , only : ESMF_StateGet, ESMF_FieldBundleGet + use ESMF , only : ESMF_STATEITEM_NOTFOUND, ESMF_StateItem_Flag + + type(ESMF_State) , intent(inout) :: STout + type(ESMF_FieldBundle), intent(in) :: FBin + logical, optional , intent(in) :: copy + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount, lrankS, lrankB + logical :: lcopy + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + type(ESMF_StateItem_Flag) :: itemType + real(R8), pointer :: dataPtrS1(:), dataPtrB1(:) + real(R8), pointer :: dataPtrS2(:,:), dataPtrB2(:,:) + integer :: dbrc + character(len=*), parameter :: subname='(shr_nuopc_methods_FB_accumFB2ST)' + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + lcopy = .false. + if (present(copy)) then + lcopy = copy + endif + + call ESMF_FieldBundleGet(FBin, fieldCount=fieldCount, rc=rc) + allocate(lfieldnamelist(fieldCount)) + call ESMF_FieldBundleGet(FBin, fieldNameList=lfieldnamelist, rc=rc) + do n = 1, fieldCount + call ESMF_StateGet(STout, itemName=lfieldnamelist(n), itemType=itemType, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (itemType /= ESMF_STATEITEM_NOTFOUND) then + + call shr_nuopc_methods_FB_GetFldPtr(FBin, lfieldnamelist(n), dataPtrB1, dataPtrB2, lrankB, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_State_GetFldPtr(STout, lfieldnamelist(n), dataPtrS1, dataPtrS2, lrankS, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (lrankB == 0 .and. lrankS == 0) then + + ! no local data + + elseif (lrankB == 1 .and. lrankS == 1) then + + if (.not.shr_nuopc_methods_FieldPtr_Compare(dataPtrS1, dataPtrB1, subname, rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr1 size ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) + rc = ESMF_FAILURE + return + endif + + if (lcopy) then + do i=lbound(dataPtrB1,1),ubound(dataPtrB1,1) + dataPtrS1(i) = dataPtrB1(i) + enddo + else + do i=lbound(dataPtrB1,1),ubound(dataPtrB1,1) + dataPtrS1(i) = dataPtrS1(i) + dataPtrB1(i) + enddo + endif + + elseif (lrankB == 2 .and. lrankS == 2) then + + if (.not.shr_nuopc_methods_FieldPtr_Compare(dataPtrS2, dataPtrB2, subname, rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr2 size ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) + rc = ESMF_FAILURE + return + endif + + if (lcopy) then + do j=lbound(dataPtrB2,2),ubound(dataPtrB2,2) + do i=lbound(dataPtrB2,1),ubound(dataPtrB2,1) + dataPtrS2(i,j) = dataPtrB2(i,j) + enddo + enddo + else + do j=lbound(dataPtrB2,2),ubound(dataPtrB2,2) + do i=lbound(dataPtrB2,1),ubound(dataPtrB2,1) + dataPtrS2(i,j) = dataPtrS2(i,j) + dataPtrB2(i,j) + enddo + enddo + endif + + else + + write(msgString,'(a,2i8)') trim(subname)//": rankB, ranks = ",lrankB,lrankS + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": ERROR rankB rankS not supported "//trim(lfieldnamelist(n)), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + + endif + + endif ! statefound + enddo ! fieldCount + + deallocate(lfieldnamelist) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_FB_accumFB2ST + + !----------------------------------------------------------------------------- + + logical function shr_nuopc_methods_FB_FldChk(FB, fldname, rc) + ! ---------------------------------------------- + ! Determine if field with fldname is in input field bundle + ! ---------------------------------------------- + + use ESMF, only : ESMF_FieldBundle, ESMF_FieldBundleGet + use ESMF, only : ESMF_FieldBundleIsCreated + + ! input/output variables + type(ESMF_FieldBundle), intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(out) :: rc + + ! local variables + integer :: dbrc + character(len=*), parameter :: subname='(shr_nuopc_methods_FB_FldChk)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + ! If field bundle is not created then set return to .false. + if (.not. ESMF_FieldBundleIsCreated(FB)) then + shr_nuopc_methods_FB_FldChk = .false. + return + end if + + ! If field bundle is created determine if fldname is present in field bundle + shr_nuopc_methods_FB_FldChk = .false. + + call ESMF_FieldBundleGet(FB, fieldName=trim(fldname), isPresent=isPresent, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) then + call ESMF_LogWrite(trim(subname)//" Error checking field: "//trim(fldname), & + ESMF_LOGMSG_ERROR, rc=dbrc) + return + endif + if (isPresent) then + shr_nuopc_methods_FB_FldChk = .true. + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end function shr_nuopc_methods_FB_FldChk + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abort, rc) + ! ---------------------------------------------- + ! for a field, determine rank and return fldptr1 or fldptr2 + ! abort is true by default and will abort if fldptr is not yet allocated in field + ! rank returns 0, 1, or 2. 0 means fldptr not allocated and abort=false + ! ---------------------------------------------- + use med_constants_mod , only : R8 + use ESMF , only : ESMF_Field,ESMF_Mesh, ESMF_FieldGet, ESMF_MeshGet + use ESMF , only : ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID, ESMF_FIELDSTATUS_COMPLETE + + type(ESMF_Field) , intent(in) :: field + real(R8), pointer , intent(inout), optional :: fldptr1(:) + real(R8), pointer , intent(inout), optional :: fldptr2(:,:) + integer , intent(out) , optional :: rank + logical , intent(in) , optional :: abort + integer , intent(out) , optional :: rc + + ! local variables + type(ESMF_Mesh) :: lmesh + integer :: lrank, nnodes, nelements + logical :: labort + integer :: dbrc + character(len=*), parameter :: subname='(shr_nuopc_methods_Field_GetFldPtr)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + if (.not.present(rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR rc not present ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + rc = ESMF_SUCCESS + + labort = .true. + if (present(abort)) then + labort = abort + endif + lrank = -99 + + call ESMF_FieldGet(field, status=status, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (status /= ESMF_FIELDSTATUS_COMPLETE) then + lrank = 0 + if (labort) then + call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + else + call ESMF_LogWrite(trim(subname)//": WARNING data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + endif + else + + call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + elseif (geomtype == ESMF_GEOMTYPE_MESH) then + lrank = 1 + call ESMF_FieldGet(field, mesh=lmesh, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (nnodes == 0 .and. nelements == 0) lrank = 0 + else ! geomtype + call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", & + ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + endif ! geomtype + + if (lrank == 0) then + call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", & + ESMF_LOGMSG_INFO, rc=dbrc) + elseif (lrank == 1) then + if (.not.present(fldptr1)) then + call ESMF_LogWrite(trim(subname)//": ERROR missing rank=1 array ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + call ESMF_FieldGet(field, farrayPtr=fldptr1, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + elseif (lrank == 2) then + if (.not.present(fldptr2)) then + call ESMF_LogWrite(trim(subname)//": ERROR missing rank=2 array ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + call ESMF_FieldGet(field, farrayPtr=fldptr2, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//": ERROR in rank ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + endif ! status + + if (present(rank)) then + rank = lrank + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_Field_GetFldPtr + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_GetFldPtr(FB, fldname, fldptr1, fldptr2, rank, field, rc) + use med_constants_mod , only : R8 + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_Field + + ! ---------------------------------------------- + ! Get pointer to a field bundle field + ! ---------------------------------------------- + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: fldname + real(R8), pointer , intent(inout), optional :: fldptr1(:) + real(R8), pointer , intent(inout), optional :: fldptr2(:,:) + integer , intent(out), optional :: rank + integer , intent(out), optional :: rc + type(ESMF_Field) , intent(out), optional :: field + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrank + integer :: dbrc + character(len=*), parameter :: subname='(shr_nuopc_methods_FB_GetFldPtr)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + if (.not.present(rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR rc not present "//trim(fldname), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + rc = ESMF_SUCCESS + + if (.not. shr_nuopc_methods_FB_FldChk(FB, trim(fldname), rc=rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR field "//trim(fldname)//" not in FB ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + call ESMF_FieldBundleGet(FB, fieldName=trim(fldname), field=lfield, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_Field_GetFldPtr(lfield, & + fldptr1=fldptr1, fldptr2=fldptr2, rank=lrank, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (present(rank)) then + rank = lrank + endif + if (present(field)) then + field = lfield + endif + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_FB_GetFldPtr + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_SetFldPtr(FB, fldname, val, rc) + use med_constants_mod, only : R8 + use ESMF, only : ESMF_FieldBundle, ESMF_Field + + type(ESMF_FieldBundle), intent(in) :: FB + character(len=*) , intent(in) :: fldname + real(R8) , intent(in) :: val + integer , intent(out) :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrank + real(R8), pointer :: fldptr1(:) + real(R8), pointer :: fldptr2(:,:) + integer :: dbrc + character(len=*), parameter :: subname='(shr_nuopc_methods_FB_SetFldPtr)' + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + call shr_nuopc_methods_FB_GetFldPtr(FB, fldname, fldptr1, fldptr2, lrank, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + fldptr1 = val + elseif (lrank == 2) then + fldptr2 = val + else + call ESMF_LogWrite(trim(subname)//": ERROR in rank "//trim(fldname), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_FB_SetFldPtr + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_GetFldPtr(ST, fldname, fldptr1, fldptr2, rank, rc) + ! ---------------------------------------------- + ! Get pointer to a state field + ! ---------------------------------------------- + use med_constants_mod, only : R8 + use ESMF, only : ESMF_State, ESMF_Field, ESMF_StateGet + + type(ESMF_State), intent(in) :: ST + character(len=*), intent(in) :: fldname + real(R8), pointer, intent(inout), optional :: fldptr1(:) + real(R8), pointer, intent(inout), optional :: fldptr2(:,:) + integer , intent(out), optional :: rank + integer , intent(out), optional :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrank + integer :: dbrc + character(len=*), parameter :: subname='(shr_nuopc_methods_State_GetFldPtr)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + if (.not.present(rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR rc not present "//trim(fldname), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + rc = ESMF_SUCCESS + + call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_Field_GetFldPtr(lfield, & + fldptr1=fldptr1, fldptr2=fldptr2, rank=lrank, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (present(rank)) then + rank = lrank + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_State_GetFldPtr + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_SetFldPtr(ST, fldname, val, rc) + use med_constants_mod, only : R8 + use ESMF, only : ESMF_State, ESMF_Field + + type(ESMF_State) , intent(in) :: ST + character(len=*) , intent(in) :: fldname + real(R8), intent(in) :: val + integer , intent(out) :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrank + real(R8), pointer :: fldptr1(:) + real(R8), pointer :: fldptr2(:,:) + integer :: dbrc + character(len=*), parameter :: subname='(shr_nuopc_methods_State_SetFldPtr)' + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + call shr_nuopc_methods_State_GetFldPtr(ST, fldname, fldptr1, fldptr2, lrank, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + fldptr1 = val + elseif (lrank == 2) then + fldptr2 = val + else + call ESMF_LogWrite(trim(subname)//": ERROR in rank "//trim(fldname), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_State_SetFldPtr + + !----------------------------------------------------------------------------- + + logical function shr_nuopc_methods_FieldPtr_Compare1(fldptr1, fldptr2, cstring, rc) + use med_constants_mod, only : R8 + real(R8), pointer, intent(in) :: fldptr1(:) + real(R8), pointer, intent(in) :: fldptr2(:) + character(len=*) , intent(in) :: cstring + integer , intent(out) :: rc + + ! local variables + integer :: dbrc + character(len=*), parameter :: subname='(shr_nuopc_methods_FieldPtr_Compare1)' + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + shr_nuopc_methods_FieldPtr_Compare1 = .false. + if (lbound(fldptr2,1) /= lbound(fldptr1,1) .or. & + ubound(fldptr2,1) /= ubound(fldptr1,1)) then + call ESMF_LogWrite(trim(subname)//": ERROR in data size "//trim(cstring), ESMF_LOGMSG_ERROR, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write(msgString,*) trim(subname)//': fldptr1 ',lbound(fldptr1),ubound(fldptr1) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + write(msgString,*) trim(subname)//': fldptr2 ',lbound(fldptr2),ubound(fldptr2) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + else + shr_nuopc_methods_FieldPtr_Compare1 = .true. + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end function shr_nuopc_methods_FieldPtr_Compare1 + + !----------------------------------------------------------------------------- + + logical function shr_nuopc_methods_FieldPtr_Compare2(fldptr1, fldptr2, cstring, rc) + use med_constants_mod, only : R8 + real(R8), pointer, intent(in) :: fldptr1(:,:) + real(R8), pointer, intent(in) :: fldptr2(:,:) + character(len=*) , intent(in) :: cstring + integer , intent(out) :: rc + + ! local variables + integer :: dbrc + character(len=*), parameter :: subname='(shr_nuopc_methods_FieldPtr_Compare2)' + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + shr_nuopc_methods_FieldPtr_Compare2 = .false. + if (lbound(fldptr2,2) /= lbound(fldptr1,2) .or. & + lbound(fldptr2,1) /= lbound(fldptr1,1) .or. & + ubound(fldptr2,2) /= ubound(fldptr1,2) .or. & + ubound(fldptr2,1) /= ubound(fldptr1,1)) then + call ESMF_LogWrite(trim(subname)//": ERROR in data size "//trim(cstring), ESMF_LOGMSG_ERROR, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write(msgString,*) trim(subname)//': fldptr2 ',lbound(fldptr2),ubound(fldptr2) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + write(msgString,*) trim(subname)//': fldptr1 ',lbound(fldptr1),ubound(fldptr1) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + else + shr_nuopc_methods_FieldPtr_Compare2 = .true. + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end function shr_nuopc_methods_FieldPtr_Compare2 + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_GeomPrint(state, string, rc) + use ESMF, only : ESMF_State, ESMF_Field, ESMF_StateGet + type(ESMF_State), intent(in) :: state + character(len=*), intent(in) :: string + integer , intent(out) :: rc + + type(ESMF_Field) :: lfield + integer :: fieldcount + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_State_GeomPrint)' + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (fieldCount > 0) then + call shr_nuopc_methods_State_GetFieldN(state, 1, lfield, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_Field_GeomPrint(lfield, string, rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO, rc=dbrc) + endif ! fieldCount > 0 + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_State_GeomPrint + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_GeomPrint(FB, string, rc) + use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldBundleGet + + type(ESMF_FieldBundle), intent(in) :: FB + character(len=*), intent(in) :: string + integer , intent(out) :: rc + + type(ESMF_Field) :: lfield + integer :: fieldcount + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_GeomPrint)' + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (fieldCount > 0) then + + call shr_nuopc_methods_Field_GeomPrint(lfield, string, rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO, rc=dbrc) + endif ! fieldCount > 0 + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_FB_GeomPrint + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_Field_GeomPrint(field, string, rc) + use med_constants_mod, only : R8 + use ESMF, only : ESMF_Field, ESMF_Grid, ESMF_Mesh + use ESMF, only : ESMF_FieldGet, ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID, ESMF_FIELDSTATUS_EMPTY + + type(ESMF_Field), intent(in) :: field + character(len=*), intent(in) :: string + integer , intent(out) :: rc + + type(ESMF_Grid) :: lgrid + type(ESMF_Mesh) :: lmesh + integer :: lrank + real(R8), pointer :: dataPtr1(:) + real(R8), pointer :: dataPtr2(:,:) + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_Field_GeomPrint)' + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + call ESMF_FieldGet(field, status=status, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (status == ESMF_FIELDSTATUS_EMPTY) then + call ESMF_LogWrite(trim(subname)//":"//trim(string)//": ERROR field does not have a geom yet ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_FieldGet(field, grid=lgrid, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_Grid_Print(lgrid, string, rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + elseif (geomtype == ESMF_GEOMTYPE_MESH) then + call ESMF_FieldGet(field, mesh=lmesh, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_Mesh_Print(lmesh, string, rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + call shr_nuopc_methods_Field_GetFldPtr(field, & + fldptr1=dataPtr1, fldptr2=dataPtr2, rank=lrank, abort=.false., rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + write (msgString,*) trim(subname)//":"//trim(string)//": dataptr bounds dim=1 ",lbound(dataptr1,1),ubound(dataptr1,1) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + elseif (lrank == 2) then + write (msgString,*) trim(subname)//":"//trim(string)//": dataptr bounds dim=1 ",lbound(dataptr2,1),ubound(dataptr2,1) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write (msgString,*) trim(subname)//":"//trim(string)//": dataptr bounds dim=2 ",lbound(dataptr2,2),ubound(dataptr2,2) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + elseif (lrank == 0) then + ! means data allocation does not exist yet + continue + else + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_Field_GeomPrint + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_Mesh_Print(mesh, string, rc) + use ESMF, only: ESMF_Mesh, ESMF_DistGrid, ESMF_MeshGet, ESMF_DistGridGet + use ESMF, only: ESMF_DELayoutGet, ESMF_DELayout + use ESMF, only: ESMF_MeshStatus_Flag, ESMF_MeshStatus_Complete + type(ESMF_Mesh) , intent(in) :: mesh + character(len=*), intent(in) :: string + integer , intent(out) :: rc + + type(ESMF_Distgrid) :: distgrid + type(ESMF_DELayout) :: delayout + integer :: pdim, sdim, nnodes, nelements + integer :: localDeCount + integer :: DeCount + integer :: dimCount, tileCount + integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) + type(ESMF_MeshStatus_Flag) :: meshStatus + logical :: elemDGPresent, nodeDGPresent + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_Mesh_Print)' + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + call ESMF_MeshGet(mesh, elementDistGridIsPresent=elemDGPresent, & + nodalDistgridIsPresent=nodeDGPresent, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(mesh, status=meshStatus, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! first get the distgrid, which should be available + if (elemDGPresent) then + call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": distGrid=element" + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DistGridGet(distgrid, deLayout=deLayout, dimCount=dimCount, & + tileCount=tileCount, deCount=deCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": dimCount=", dimCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": tileCount=", tileCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": deCount=", deCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DELayoutGet(deLayout, localDeCount=localDeCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": localDeCount=", localDeCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! allocate minIndexPTile and maxIndexPTile accord. to dimCount and tileCount + allocate(minIndexPTile(dimCount, tileCount), & + maxIndexPTile(dimCount, tileCount)) + + ! get minIndex and maxIndex arrays + call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & + maxIndexPTile=maxIndexPTile, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": minIndexPTile=", minIndexPTile + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": maxIndexPTile=", maxIndexPTile + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + deallocate(minIndexPTile, maxIndexPTile) + + endif + + if (nodeDGPresent) then + call ESMF_MeshGet(mesh, nodalDistgrid=distgrid, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": distGrid=nodal" + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DistGridGet(distgrid, deLayout=deLayout, dimCount=dimCount, & + tileCount=tileCount, deCount=deCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": dimCount=", dimCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": tileCount=", tileCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": deCount=", deCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DELayoutGet(deLayout, localDeCount=localDeCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": localDeCount=", localDeCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! allocate minIndexPTile and maxIndexPTile accord. to dimCount and tileCount + allocate(minIndexPTile(dimCount, tileCount), & + maxIndexPTile(dimCount, tileCount)) + + ! get minIndex and maxIndex arrays + call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & + maxIndexPTile=maxIndexPTile, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": minIndexPTile=", minIndexPTile + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": maxIndexPTile=", maxIndexPTile + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + deallocate(minIndexPTile, maxIndexPTile) + + endif + + if (.not. elemDGPresent .and. .not. nodeDGPresent) then + call ESMF_LogWrite(trim(subname)//": cannot print distgrid from mesh", & + ESMF_LOGMSG_WARNING, rc=rc) + return + endif + + ! if mesh is complete, also get additional parameters + if (meshStatus==ESMF_MESHSTATUS_COMPLETE) then + ! access localDeCount to show this is a real Grid + call ESMF_MeshGet(mesh, parametricDim=pdim, spatialDim=sdim, & + numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": parametricDim=", pdim + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + write (msgString,*) trim(subname)//":"//trim(string)//": spatialDim=", sdim + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + write (msgString,*) trim(subname)//":"//trim(string)//": numOwnedNodes=", nnodes + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + write (msgString,*) trim(subname)//":"//trim(string)//": numOwnedElements=", nelements + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_Mesh_Print + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_Grid_Print(grid, string, rc) + use med_constants_mod, only : R8 + use ESMF, only : ESMF_Grid, ESMF_DistGrid, ESMF_StaggerLoc + use ESMF, only : ESMF_GridGet, ESMF_DistGridGet, ESMF_GridGetCoord + use ESMF, only : ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER + type(ESMF_Grid) , intent(in) :: grid + character(len=*), intent(in) :: string + integer , intent(out) :: rc + + type(ESMF_Distgrid) :: distgrid + integer :: localDeCount + integer :: DeCount + integer :: dimCount, tileCount + integer :: staggerlocCount, arbdimCount, rank + type(ESMF_StaggerLoc) :: staggerloc + character(len=32) :: staggerstr + integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) + real(R8), pointer :: fldptr1(:) + real(R8), pointer :: fldptr2(:,:) + integer :: n1,n2,n3 + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_Grid_Print)' + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + ! access localDeCount to show this is a real Grid + call ESMF_GridGet(grid, localDeCount=localDeCount, distgrid=distgrid, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": localDeCount=", localDeCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! get dimCount and tileCount + call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, deCount=deCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": dimCount=", dimCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": tileCount=", tileCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": deCount=", deCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! allocate minIndexPTile and maxIndexPTile accord. to dimCount and tileCount + allocate(minIndexPTile(dimCount, tileCount), & + maxIndexPTile(dimCount, tileCount)) + + ! get minIndex and maxIndex arrays + call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & + maxIndexPTile=maxIndexPTile, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": minIndexPTile=", minIndexPTile + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": maxIndexPTile=", maxIndexPTile + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + deallocate(minIndexPTile, maxIndexPTile) + + ! get staggerlocCount, arbDimCount +! call ESMF_GridGet(grid, staggerlocCount=staggerlocCount, rc=rc) +! if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + +! write (msgString,*) trim(subname)//":"//trim(string)//": staggerlocCount=", staggerlocCount +! call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) +! if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + +! call ESMF_GridGet(grid, arbDimCount=arbDimCount, rc=rc) +! if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + +! write (msgString,*) trim(subname)//":"//trim(string)//": arbDimCount=", arbDimCount +! call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) +! if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! get rank + call ESMF_GridGet(grid, rank=rank, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": rank=", rank + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + do n1 = 1,2 + if (n1 == 1) then + staggerloc = ESMF_STAGGERLOC_CENTER + staggerstr = 'ESMF_STAGGERLOC_CENTER' + elseif (n1 == 2) then + staggerloc = ESMF_STAGGERLOC_CORNER + staggerstr = 'ESMF_STAGGERLOC_CORNER' + else + rc = ESMF_FAILURE + call ESMF_LogWrite(trim(subname)//":staggerloc failure", ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + call ESMF_GridGetCoord(grid, staggerloc=staggerloc, isPresent=isPresent, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write (msgString,*) trim(subname)//":"//trim(staggerstr)//" present=",isPresent + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + do n3 = 0,localDECount-1 + do n2 = 1,dimCount + if (rank == 1) then + call ESMF_GridGetCoord(grid,coordDim=n2,localDE=n3,staggerloc=staggerloc,farrayPtr=fldptr1,rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write (msgString,'(a,2i4,2f16.8)') trim(subname)//":"//trim(staggerstr)//" coord=",n2,n3,minval(fldptr1),maxval(fldptr1) + endif + if (rank == 2) then + call ESMF_GridGetCoord(grid,coordDim=n2,localDE=n3,staggerloc=staggerloc,farrayPtr=fldptr2,rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write (msgString,'(a,2i4,2f16.8)') trim(subname)//":"//trim(staggerstr)//" coord=",n2,n3,minval(fldptr2),maxval(fldptr2) + endif + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + enddo + enddo + endif + enddo + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_Grid_Print + +!----------------------------------------------------------------------------- + subroutine shr_nuopc_methods_Clock_TimePrint(clock,string,rc) + + use med_constants_mod , only : CS, CL + use ESMF , only : ESMF_Clock, ESMF_Time, ESMF_TimeInterval + use ESMF , only : ESMF_ClockGet, ESMF_TimeGet, ESMF_TimeIntervalGet + + ! input/output variables + type(ESMF_Clock) , intent(in) :: clock + character(len=*) , intent(in),optional :: string + integer , intent(out) :: rc + + ! local variables + type(ESMF_Time) :: time + type(ESMF_TimeInterval) :: timeStep + character(len=CS) :: timestr + character(len=CL) :: lstring + integer :: dbrc + character(len=*), parameter :: subname='(shr_nuopc_methods_Clock_TimePrint)' + + rc = ESMF_SUCCESS + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + if (present(string)) then + lstring = trim(subname)//":"//trim(string) + else + lstring = trim(subname) + endif + + call ESMF_ClockGet(clock,currtime=time,rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(time,timestring=timestr,rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(lstring)//": currtime = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) + + call ESMF_ClockGet(clock,starttime=time,rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(time,timestring=timestr,rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(lstring)//": startime = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) + + call ESMF_ClockGet(clock,stoptime=time,rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(time,timestring=timestr,rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(lstring)//": stoptime = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) + + call ESMF_ClockGet(clock,timestep=timestep,rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeIntervalGet(timestep,timestring=timestr,rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(lstring)//": timestep = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_Clock_TimePrint + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_Mesh_Write(mesh, string, rc) + + use med_constants_mod, only : R8, CS + use ESMF, only : ESMF_Mesh, ESMF_MeshGet, ESMF_Array, ESMF_ArrayWrite, ESMF_DistGrid + + type(ESMF_Mesh) ,intent(in) :: mesh + character(len=*),intent(in) :: string + integer ,intent(out) :: rc + + ! local + integer :: n,l,i,lsize,ndims + character(len=CS) :: name + type(ESMF_DISTGRID) :: distgrid + type(ESMF_Array) :: array + real(R8), pointer :: rawdata(:) + real(R8), pointer :: coord(:) + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_Mesh_Write)' + + rc = ESMF_SUCCESS + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + +#if (1 == 0) + !--- elements --- + + call ESMF_MeshGet(mesh, spatialDim=ndims, numownedElements=lsize, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(rawdata(ndims*lsize)) + allocate(coord(lsize)) + + call ESMF_MeshGet(mesh, elementDistgrid=distgrid, ownedElemCoords=rawdata, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1,ndims + name = "unknown" + if (n == 1) name = "lon_element" + if (n == 2) name = "lat_element" + do l = 1,lsize + i = 2*(l-1) + n + coord(l) = rawdata(i) + array = ESMF_ArrayCreate(distgrid, farrayPtr=coord, name=name, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + enddo + enddo + + deallocate(rawdata,coord) + + !--- nodes --- + + call ESMF_MeshGet(mesh, spatialDim=ndims, numownedNodes=lsize, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(rawdata(ndims*lsize)) + allocate(coord(lsize)) + + call ESMF_MeshGet(mesh, nodalDistgrid=distgrid, ownedNodeCoords=rawdata, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1,ndims + name = "unknown" + if (n == 1) name = "lon_nodes" + if (n == 2) name = "lat_nodes" + do l = 1,lsize + i = 2*(l-1) + n + coord(l) = rawdata(i) + array = ESMF_ArrayCreate(distgrid, farrayPtr=coord, name=name, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + enddo + enddo + + deallocate(rawdata,coord) +#else + call ESMF_LogWrite(trim(subname)//": turned off right now", ESMF_LOGMSG_INFO, rc=dbrc) +#endif + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_Mesh_Write + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_GeomWrite(state, string, rc) + use ESMF, only : ESMF_State, ESMF_Field, ESMF_StateGet + type(ESMF_State), intent(in) :: state + character(len=*), intent(in) :: string + integer , intent(out) :: rc + + type(ESMF_Field) :: lfield + integer :: fieldcount + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_State_GeomWrite)' + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (fieldCount > 0) then + call shr_nuopc_methods_State_getFieldN(state, 1, lfield, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_Field_GeomWrite(lfield, string, rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO, rc=dbrc) + endif ! fieldCount > 0 + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_State_GeomWrite + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_GeomWrite(FB, string, rc) + use ESMF, only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleGet + + type(ESMF_FieldBundle), intent(in) :: FB + character(len=*), intent(in) :: string + integer , intent(out) :: rc + + type(ESMF_Field) :: lfield + integer :: fieldcount + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_GeomWrite)' + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (fieldCount > 0) then + call shr_nuopc_methods_FB_getFieldN(FB, 1, lfield, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_Field_GeomWrite(lfield, string, rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO, rc=dbrc) + endif ! fieldCount > 0 + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_FB_GeomWrite + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_Field_GeomWrite(field, string, rc) + use ESMF, only : ESMF_Field, ESMF_Grid, ESMF_Mesh, ESMF_FIeldGet, ESMF_FIELDSTATUS_EMPTY + use ESMF, only : ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID + + type(ESMF_Field), intent(in) :: field + character(len=*), intent(in) :: string + integer , intent(out) :: rc + + type(ESMF_Grid) :: lgrid + type(ESMF_Mesh) :: lmesh + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_Field_GeomWrite)' + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + rc = ESMF_SUCCESS + + call ESMF_FieldGet(field, status=status, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (status == ESMF_FIELDSTATUS_EMPTY) then + call ESMF_LogWrite(trim(subname)//":"//trim(string)//": ERROR field does not have a geom yet ", ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_FieldGet(field, grid=lgrid, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_Grid_Write(lgrid, string, rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + elseif (geomtype == ESMF_GEOMTYPE_MESH) then + call ESMF_FieldGet(field, mesh=lmesh, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_Mesh_Write(lmesh, string, rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_Field_GeomWrite + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_Grid_Write(grid, string, rc) + + use med_constants_mod , only : CS + use ESMF , only : ESMF_Grid, ESMF_Array, ESMF_GridGetCoord, ESMF_ArraySet + use ESMF , only : ESMF_ArrayWrite, ESMF_GridGetItem, ESMF_GridGetCoord + use ESMF , only : ESMF_GRIDITEM_AREA, ESMF_GRIDITEM_MASK + use ESMF , only : ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER + + ! input/output variables + type(ESMF_Grid) ,intent(in) :: grid + character(len=*),intent(in) :: string + integer ,intent(out) :: rc + + ! local + type(ESMF_Array) :: array + character(len=CS) :: name + integer :: dbrc + character(len=*),parameter :: subname='(shr_nuopc_methods_Grid_Write)' + + rc = ESMF_SUCCESS + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + ! -- centers -- + + call ESMF_GridGetCoord(grid, staggerLoc=ESMF_STAGGERLOC_CENTER, isPresent=isPresent, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + name = "lon_center" + call ESMF_GridGetCoord(grid, coordDim=1, staggerLoc=ESMF_STAGGERLOC_CENTER, array=array, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArraySet(array, name=name, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + name = "lat_center" + call ESMF_GridGetCoord(grid, coordDim=2, staggerLoc=ESMF_STAGGERLOC_CENTER, array=array, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArraySet(array, name=name, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + ! -- corners -- + + call ESMF_GridGetCoord(grid, staggerLoc=ESMF_STAGGERLOC_CORNER, isPresent=isPresent, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + name = "lon_corner" + call ESMF_GridGetCoord(grid, coordDim=1, staggerLoc=ESMF_STAGGERLOC_CORNER, array=array, rc=rc) + if (.not. ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) then + call ESMF_ArraySet(array, name=name, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + name = "lat_corner" + call ESMF_GridGetCoord(grid, coordDim=2, staggerLoc=ESMF_STAGGERLOC_CORNER, array=array, rc=rc) + if (.not. ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) then + call ESMF_ArraySet(array, name=name, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + endif + + ! -- mask -- + + name = "mask" + call ESMF_GridGetItem(grid, itemflag=ESMF_GRIDITEM_MASK, staggerLoc=ESMF_STAGGERLOC_CENTER, isPresent=isPresent, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + call ESMF_GridGetItem(grid, staggerLoc=ESMF_STAGGERLOC_CENTER, itemflag=ESMF_GRIDITEM_MASK, array=array, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArraySet(array, name=name, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + ! -- area -- + + name = "area" + call ESMF_GridGetItem(grid, itemflag=ESMF_GRIDITEM_AREA, staggerLoc=ESMF_STAGGERLOC_CENTER, isPresent=isPresent, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + call ESMF_GridGetItem(grid, staggerLoc=ESMF_STAGGERLOC_CENTER, itemflag=ESMF_GRIDITEM_AREA, array=array, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArraySet(array, name=name, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//trim(name), rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end subroutine shr_nuopc_methods_Grid_Write + + !----------------------------------------------------------------------------- + + logical function shr_nuopc_methods_Distgrid_Match(distGrid1, distGrid2, rc) + use ESMF, only : ESMF_DistGrid, ESMF_DistGridGet + ! Arguments + type(ESMF_DistGrid), intent(in) :: distGrid1 + type(ESMF_DistGrid), intent(in) :: distGrid2 + integer, intent(out), optional :: rc + + ! Local Variables + integer :: dimCount1, dimCount2 + integer :: tileCount1, tileCount2 + integer, allocatable :: minIndexPTile1(:,:), minIndexPTile2(:,:) + integer, allocatable :: maxIndexPTile1(:,:), maxIndexPTile2(:,:) + integer, allocatable :: elementCountPTile1(:), elementCountPTile2(:) + integer :: dbrc + character(len=*), parameter :: subname='(shr_nuopc_methods_Distgrid_Match)' + + if (dbug_flag > 10) then + call ESMF_LogWrite(subname//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + if(present(rc)) rc = ESMF_SUCCESS + shr_nuopc_methods_Distgrid_Match = .true. + + call ESMF_DistGridGet(distGrid1, & + dimCount=dimCount1, tileCount=tileCount1, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DistGridGet(distGrid2, & + dimCount=dimCount2, tileCount=tileCount2, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if ( dimCount1 /= dimCount2) then + shr_nuopc_methods_Distgrid_Match = .false. + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": Grid dimCount MISMATCH ", & + ESMF_LOGMSG_INFO, rc=dbrc) + endif + endif + + if ( tileCount1 /= tileCount2) then + shr_nuopc_methods_Distgrid_Match = .false. + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": Grid tileCount MISMATCH ", & + ESMF_LOGMSG_INFO, rc=dbrc) + endif + endif + + allocate(elementCountPTile1(tileCount1)) + allocate(elementCountPTile2(tileCount2)) + allocate(minIndexPTile1(dimCount1,tileCount1)) + allocate(minIndexPTile2(dimCount2,tileCount2)) + allocate(maxIndexPTile1(dimCount1,tileCount1)) + allocate(maxIndexPTile2(dimCount2,tileCount2)) + + call ESMF_DistGridGet(distGrid1, & + elementCountPTile=elementCountPTile1, & + minIndexPTile=minIndexPTile1, & + maxIndexPTile=maxIndexPTile1, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DistGridGet(distGrid2, & + elementCountPTile=elementCountPTile2, & + minIndexPTile=minIndexPTile2, & + maxIndexPTile=maxIndexPTile2, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if ( ANY((elementCountPTile1 - elementCountPTile2) .NE. 0) ) then + shr_nuopc_methods_Distgrid_Match = .false. + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": Grid elementCountPTile MISMATCH ", & + ESMF_LOGMSG_INFO, rc=dbrc) + endif + endif + + if ( ANY((minIndexPTile1 - minIndexPTile2) .NE. 0) ) then + shr_nuopc_methods_Distgrid_Match = .false. + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": Grid minIndexPTile MISMATCH ", & + ESMF_LOGMSG_INFO, rc=dbrc) + endif + endif + + if ( ANY((maxIndexPTile1 - maxIndexPTile2) .NE. 0) ) then + shr_nuopc_methods_Distgrid_Match = .false. + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": Grid maxIndexPTile MISMATCH ", & + ESMF_LOGMSG_INFO, rc=dbrc) + endif + endif + + deallocate(elementCountPTile1) + deallocate(elementCountPTile2) + deallocate(minIndexPTile1) + deallocate(minIndexPTile2) + deallocate(maxIndexPTile1) + deallocate(maxIndexPTile2) + + ! TODO: Optionally Check Coordinates + + + if (dbug_flag > 10) then + call ESMF_LogWrite(subname//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + end function shr_nuopc_methods_Distgrid_Match + +!================================================================================ + + subroutine shr_nuopc_methods_State_GetScalar(State, scalar_id, value, flds_scalar_name, flds_scalar_num, rc) + use med_constants_mod , only : R8 + use ESMF , only : ESMF_SUCCESS, ESMF_State, ESMF_StateGet, ESMF_Field, ESMF_FieldGet + use ESMF , only : ESMF_FAILURE, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_LogWrite + use ESMF , only : ESMF_LOGMSG_INFO, ESMF_VM, ESMF_VMBroadCast, ESMF_VMGetCurrent + use ESMF , only : ESMF_VMGet + ! ---------------------------------------------- + ! Get scalar data from State for a particular name and broadcast it to all other pets + ! ---------------------------------------------- + + type(ESMF_State), intent(in) :: State + integer, intent(in) :: scalar_id + real(R8), intent(out) :: value + character(len=*), intent(in) :: flds_scalar_name + integer, intent(in) :: flds_scalar_num + integer, intent(inout) :: rc + + ! local variables + integer :: mytask, ierr, len + type(ESMF_VM) :: vm + type(ESMF_Field) :: field + real(R8), pointer :: farrayptr(:,:) + real(r8) :: tmp(1) + integer :: dbrc + character(len=*), parameter :: subname='(shr_nuopc_methods_State_GetScalar)' + + rc = ESMF_SUCCESS + + call ESMF_VMGetCurrent(vm, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (mytask == 0) then + call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then + call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + endif + tmp(:) = farrayptr(scalar_id,:) + endif + call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + value = tmp(1) + + + end subroutine shr_nuopc_methods_State_GetScalar + +!================================================================================ + + subroutine shr_nuopc_methods_State_SetScalar(value, scalar_id, State, flds_scalar_name, flds_scalar_num, rc) + ! ---------------------------------------------- + ! Set scalar data from State for a particular name + ! ---------------------------------------------- + use med_constants_mod , only : R8 + use ESMF , only : ESMF_Field, ESMF_State, ESMF_StateGet, ESMF_FieldGet + use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet + real(R8), intent(in) :: value + integer, intent(in) :: scalar_id + type(ESMF_State), intent(inout) :: State + character(len=*), intent(in) :: flds_scalar_name + integer, intent(in) :: flds_scalar_num + integer, intent(inout) :: rc + + ! local variables + integer :: mytask + type(ESMF_Field) :: field + type(ESMF_VM) :: vm + real(R8), pointer :: farrayptr(:,:) + integer :: dbrc + character(len=*), parameter :: subname='(shr_nuopc_methods_State_SetScalar)' + + rc = ESMF_SUCCESS + + call ESMF_VMGetCurrent(vm, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (mytask == 0) then + call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then + call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u, rc=dbrc) + rc = ESMF_FAILURE + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + endif + farrayptr(scalar_id,1) = value + endif + + end subroutine shr_nuopc_methods_State_SetScalar + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_UpdateTimestamp(state, time, rc) + use NUOPC , only : NUOPC_GetStateMemberLists + use ESMF , only : ESMF_State, ESMF_Time, ESMF_Field, ESMF_SUCCESS + + type(ESMF_State) , intent(inout) :: state + type(ESMF_Time) , intent(in) :: time + integer , intent(out) :: rc + + ! local variables + integer :: i + type(ESMF_Field),pointer :: fieldList(:) + integer :: dbrc + character(len=*), parameter :: subname='(shr_nuopc_methods_State_UpdateTimestamp)' + + rc = ESMF_SUCCESS + + call NUOPC_GetStateMemberLists(state, fieldList=fieldList, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + do i=1, size(fieldList) + call shr_nuopc_methods_Field_UpdateTimestamp(fieldList(i), time, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + enddo + + end subroutine shr_nuopc_methods_State_UpdateTimestamp + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_Field_UpdateTimestamp(field, time, rc) + use ESMF, only : ESMF_Field, ESMF_Time, ESMF_TimeGet, ESMF_AttributeSet, ESMF_ATTNEST_ON, ESMF_SUCCESS + + type(ESMF_Field) , intent(inout) :: field + type(ESMF_Time) , intent(in) :: time + integer , intent(out) :: rc + + ! local variables + integer :: yy, mm, dd, h, m, s, ms, us, ns + integer :: dbrc + character(len=*), parameter :: subname='(shr_nuopc_methods_Field_UpdateTimestamp)' + + rc = ESMF_SUCCESS + + call ESMF_TimeGet(time, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, ms=ms, us=us, & + ns=ns, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AttributeSet(field, & + name="TimeStamp", valueList=(/yy,mm,dd,h,m,s,ms,us,ns/), & + convention="NUOPC", purpose="Instance", & + attnestflag=ESMF_ATTNEST_ON, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine shr_nuopc_methods_Field_UpdateTimestamp + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_Print_FieldExchInfo(flag, values, logunit, fldlist, nflds, istr) + use shr_nuopc_utils_mod , only : shr_nuopc_string_listGetName + use med_constants_mod , only : R8 + use ESMF , only : ESMF_MAXSTR + + ! !DESCRIPTION: + ! Print out information about values to stdount + ! - flag sets the level of information: + ! - print out names of fields in values 2d array + ! - also print out local max and min of data in values 2d array + ! If optional argument istr is present, it will be output before any of the information. + + + ! !INPUT/OUTPUT PARAMETERS: + integer , intent(in) :: flag ! info level flag + real(R8) , intent(in) :: values(:,:) ! arrays sent to/recieved from mediator + integer , intent(in) :: logunit + character(len=*) , intent(in) :: fldlist + integer , intent(in) :: nflds + character(*) , intent(in),optional :: istr ! string for print + + !--- local --- + integer :: n ! generic indicies + integer :: nsize ! grid point in values array + real(R8) :: minl(nflds) ! local min + real(R8) :: maxl(nflds) ! local max + character(len=ESMF_MAXSTR) :: name + + !--- formats --- + character(*),parameter :: subName = '(shr_nuopc_methods_Print_FieldExchInfo) ' + character(*),parameter :: F00 = "('(shr_nuopc_methods_Print_FieldExchInfo) ',8a)" + character(*),parameter :: F01 = "('(shr_nuopc_methods_Print_FieldExchInfo) ',a,i9)" + character(*),parameter :: F02 = "('(shr_nuopc_methods_Print_FieldExchInfo) ',240a)" + character(*),parameter :: F03 = "('(shr_nuopc_methods_Print_FieldExchInfo) ',a,2es11.3,i4,2x,a)" + !------------------------------------------------------------------------------- + + if (flag >= 1) then + if (present(istr)) then + write(logunit,*) trim(istr) + endif + nsize = size(values, dim=2) + write(logunit,F01) "local size =",nsize + write(logunit,F02) "Fldlist = ",trim(fldlist) + endif + + if (flag >= 2) then + do n = 1, nflds + minl(n) = minval(values(n,:)) + maxl(n) = maxval(values(n,:)) + call shr_nuopc_string_listGetName(fldlist, n, name) + write(logunit,F03) 'l min/max ',minl(n),maxl(n),n,trim(name) + enddo + endif + + end subroutine shr_nuopc_methods_Print_FieldExchInfo + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_FldDebug(state, flds_scalar_name, prefix, ymd, tod, logunit, rc) + + use ESMF , only : ESMF_State, ESMF_StateGet, ESMF_Field, ESMF_FieldGet + use med_constants_mod , only : R8 + + ! input/output variables + type(ESMF_State) :: state + character(len=*) , intent(in) :: flds_scalar_name + character(len=*) , intent(in) :: prefix + integer , intent(in) :: ymd + integer , intent(in) :: tod + integer , intent(in) :: logunit + integer , intent(out) :: rc + + ! local variables + integer :: n, nfld, nlev + integer :: lsize + real(R8), pointer :: dataPtr1d(:) + real(R8), pointer :: dataPtr2d(:,:) + integer :: fieldCount + integer :: ungriddedUBound(1) + character(len=ESMF_MAXSTR) :: string + type(ESMF_Field) , allocatable :: lfields(:) + integer , allocatable :: dimCounts(:) + character(len=ESMF_MAXSTR) , allocatable :: fieldNameList(:) + !----------------------------------------------------- + + ! Determine the list of fields and the dimension count for each field + call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + allocate(fieldNameList(fieldCount)) + allocate(lfields(fieldCount)) + allocate(dimCounts(fieldCount)) + + call ESMF_StateGet(state, itemNameList=fieldNameList, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + do nfld=1, fieldCount + call ESMF_StateGet(state, itemName=trim(fieldNameList(nfld)), field=lfields(nfld), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfields(nfld), dimCount=dimCounts(nfld), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + ! Determine local size of field + do nfld=1, fieldCount + if (dimCounts(nfld) == 1) then + call ESMF_FieldGet(lfields(nfld), farrayPtr=dataPtr1d, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + lsize = size(dataPtr1d) + exit + end if + end do + + ! Write out debug output + do n = 1,lsize + do nfld=1, fieldCount + if (dimCounts(nfld) == 1) then + call ESMF_FieldGet(lfields(nfld), farrayPtr=dataPtr1d, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(fieldNameList(nfld)) /= flds_scalar_name .and. dataPtr1d(n) /= 0.) then + string = trim(prefix) // ' ymd, tod, index, '// trim(fieldNameList(nfld)) //' = ' + write(logunit,100) trim(string), ymd, tod, n, dataPtr1d(n) +100 format(a60,3(i8,2x),d21.14) + end if + else if (dimCounts(nfld) == 2) then + call ESMF_FieldGet(lfields(nfld), farrayPtr=dataPtr2d, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfields(nfld), ungriddedUBound=ungriddedUBound, rc=rc) + call ESMF_FieldGet(lfields(nfld), farrayPtr=dataPtr2d, rc=rc) + do nlev = 1,ungriddedUBound(1) + if (trim(fieldNameList(nfld)) /= flds_scalar_name .and. dataPtr2d(n,nlev) /= 0.) then + string = trim(prefix) // ' ymd, tod, lev, index, '// trim(fieldNameList(nfld)) //' = ' + write(logunit,101) trim(string), ymd, tod, nlev, n, dataPtr2d(n,nlev) +101 format(a60,4(i8,2x),d21.14) + end if + end do + end if + end do + end do + + deallocate(fieldNameList) + deallocate(lfields) + deallocate(dimCounts) + + end subroutine shr_nuopc_methods_State_FldDebug + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_getNumFlds(FB, string, nflds, rc) + + ! ---------------------------------------------- + ! Determine if fieldbundle is created and if so, the number of non-scalar + ! fields in the field bundle + ! ---------------------------------------------- + + use ESMF, only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_FieldBundleIsCreated + + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: string + integer , intent(out) :: nflds + integer , intent(inout) :: rc + + ! local variables + integer :: dbrc + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + if (.not. ESMF_FieldBundleIsCreated(FB)) then + call ESMF_LogWrite(trim(string)//": has not been created, returning", ESMF_LOGMSG_INFO, rc=dbrc) + nflds = 0 + else + ! Note - the scalar field has been removed from all mediator + ! field bundles - so this is why we check if the fieldCount is 0 and not 1 here + + call ESMF_FieldBundleGet(FB, fieldCount=nflds, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (nflds == 0) then + call ESMF_LogWrite(trim(string)//": only has scalar data, returning", ESMF_LOGMSG_INFO, rc=dbrc) + end if + end if + + end subroutine shr_nuopc_methods_FB_getNumFlds + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_States_GetSharedFlds(State1, State2, flds_scalar_name, fldnames_shared, rc) + + ! ---------------------------------------------- + ! Get shared Fld names between State1 and State2 and + ! allocate the return array fldnames_shared + ! ---------------------------------------------- + + use ESMF, only : ESMF_State, ESMF_StateGet, ESMF_MAXSTR + + ! input/output variables + type(ESMF_State) , intent(in) :: State1 + type(ESMF_State) , intent(in) :: State2 + character(len=*) , intent(in) :: flds_scalar_name + character(len=ESMF_MAXSTR) , pointer :: fldnames_shared(:) + integer , intent(inout) :: rc + + ! local variables + integer :: ncnt1, ncnt2 + integer :: n1, n2, nshr + character(len=ESMF_MAXSTR), allocatable :: fldnames1(:) + character(len=ESMF_MAXSTR), allocatable :: fldnames2(:) + character(len=*), parameter :: subname='(shr_nuopc_methods_States_GetSharedFlds)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + if (associated(fldnames_shared)) then + call ESMF_LogWrite(trim(subname)//": ERROR fldnames_shared must not be associated ", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + RETURN + end if + + call ESMF_StateGet(State1, itemCount=ncnt1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(fldnames1(ncnt1)) + call ESMF_StateGet(State1, itemNameList=fldnames1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(State2, itemCount=ncnt2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(fldnames2(ncnt2)) + call ESMF_StateGet(State2, itemNameList=fldnames2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + nshr = 0 + do n1 = 1,ncnt1 + do n2 = 1,ncnt2 + if (trim(fldnames1(n1)) == trim(fldnames2(n2)) .and. trim(fldnames1(n1)) /= flds_scalar_name) then + nshr = nshr + 1 + end if + end do + end do + allocate(fldnames_shared(nshr)) + + nshr = 0 + do n1 = 1,ncnt1 + do n2 = 1,ncnt2 + if (trim(fldnames1(n1)) == trim(fldnames2(n2)) .and. trim(fldnames1(n1)) /= flds_scalar_name) then + nshr = nshr + 1 + fldnames_shared(nshr) = trim(fldnames1(n1)) + exit + end if + end do + end do + + end subroutine shr_nuopc_methods_States_GetSharedFlds + +end module shr_nuopc_methods_mod + diff --git a/src/shr/shr_nuopc_multiinst_mod.F90 b/src/shr/shr_nuopc_multiinst_mod.F90 new file mode 100644 index 00000000..66ec6444 --- /dev/null +++ b/src/shr/shr_nuopc_multiinst_mod.F90 @@ -0,0 +1,22 @@ +module shr_nuopc_multiinst_mod + + implicit none + public + + ! NOTE: NUM_COMP_INST_XXX are cpp variables set in buildlib.csm_share + + integer, parameter :: num_inst_atm = NUM_COMP_INST_ATM + integer, parameter :: num_inst_lnd = NUM_COMP_INST_LND + integer, parameter :: num_inst_ocn = NUM_COMP_INST_OCN + integer, parameter :: num_inst_ice = NUM_COMP_INST_ICE + integer, parameter :: num_inst_glc = NUM_COMP_INST_GLC + integer, parameter :: num_inst_wav = NUM_COMP_INST_WAV + integer, parameter :: num_inst_rof = NUM_COMP_INST_ROF + integer, parameter :: num_inst_esp = NUM_COMP_INST_ESP + integer, parameter :: num_inst_total = & + num_inst_atm + num_inst_lnd + num_inst_ocn + num_inst_ice + & + num_inst_glc + num_inst_wav + num_inst_rof + num_inst_esp + 1 + + integer :: num_inst_min, num_inst_max + +end module shr_nuopc_multiinst_mod diff --git a/src/shr/shr_nuopc_scalars_mod.F90 b/src/shr/shr_nuopc_scalars_mod.F90 new file mode 100644 index 00000000..330fcc68 --- /dev/null +++ b/src/shr/shr_nuopc_scalars_mod.F90 @@ -0,0 +1,29 @@ +module shr_nuopc_scalars_mod + + !---------------------------------------------------------------------------- + ! scalars + !---------------------------------------------------------------------------- + + implicit none + public + + character(len=*) , parameter :: flds_scalar_name = "cpl_scalars" + + integer, parameter :: flds_scalar_index_nx = 1 + integer, parameter :: flds_scalar_index_ny = 2 + integer, parameter :: flds_scalar_index_precip_fact = 3 + integer, parameter :: flds_scalar_index_nextsw_cday = 4 + integer, parameter :: flds_scalar_index_dead_comps = 5 + integer, parameter :: flds_scalar_index_rofice_present = 6 ! does rof have iceberg coupling on + integer, parameter :: flds_scalar_index_flood_present = 7 ! does rof have flooding on + integer, parameter :: flds_scalar_index_iceberg_prognostic = 10 ! does ice model support icebergs + integer, parameter :: flds_scalar_index_glclnd_present = 11 ! does glc have land coupling fields on + integer, parameter :: flds_scalar_index_glcocn_present = 12 ! does glc have ocean runoff on + integer, parameter :: flds_scalar_index_glcice_present = 13 ! does glc have iceberg coupling on + integer, parameter :: flds_scalar_index_glc_valid_input = 14 ! does glc have is valid accumulated data being sent to it? + ! (only valid if glc_prognostic is .true.) + integer, parameter :: flds_scalar_index_glc_coupled = 15 ! does glc send fluxes to other components + ! (only relevant if glc_present is .true.) + integer, parameter :: flds_scalar_num = 15 + +end module shr_nuopc_scalars_mod diff --git a/src/shr/shr_nuopc_time_mod.F90 b/src/shr/shr_nuopc_time_mod.F90 new file mode 100644 index 00000000..0d3ee8d7 --- /dev/null +++ b/src/shr/shr_nuopc_time_mod.F90 @@ -0,0 +1,959 @@ +module shr_nuopc_time_mod + ! !USES: + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_GridCompSet + use ESMF , only : ESMF_Clock, ESMF_ClockCreate, ESMF_ClockGet, ESMF_ClockSet + use ESMF , only : ESMF_ClockAdvance + use ESMF , only : ESMF_Alarm, ESMF_AlarmCreate, ESMF_AlarmGet + use ESMF , only : ESMF_Calendar, ESMF_CalKind_Flag, ESMF_CalendarCreate + use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN + use ESMF , only : ESMF_Time, ESMF_TimeGet, ESMF_TimeSet + use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE + use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast + use ESMF , only : operator(<), operator(/=), operator(+) + use ESMF , only : operator(-), operator(*) , operator(>=) + use ESMF , only : operator(<=), operator(>), operator(==) + use NUOPC , only : NUOPC_CompAttributeGet + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use shr_nuopc_utils_mod , only : shr_nuopc_abort + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + + implicit none + private ! default private + + public :: shr_nuopc_time_alarmInit ! initialize an alarm + public :: shr_nuopc_time_clockInit ! initialize driver clock + public :: shr_nuopc_time_set_component_stop_alarm + + private :: shr_nuopc_time_timeInit + private :: shr_nuopc_time_date2ymd + + ! Clock and alarm options + character(len=*), private, parameter :: & + optNONE = "none" , & + optNever = "never" , & + optNSteps = "nsteps" , & + optNStep = "nstep" , & + optNSeconds = "nseconds" , & + optNSecond = "nsecond" , & + optNMinutes = "nminutes" , & + optNMinute = "nminute" , & + optNHours = "nhours" , & + optNHour = "nhour" , & + optNDays = "ndays" , & + optNDay = "nday" , & + optNMonths = "nmonths" , & + optNMonth = "nmonth" , & + optNYears = "nyears" , & + optNYear = "nyear" , & + optMonthly = "monthly" , & + optYearly = "yearly" , & + optDate = "date" , & + optIfdays0 = "ifdays0" , & + optGLCCouplingPeriod = "glc_coupling_period" + + ! Module data + integer, parameter :: SecPerDay = 86400 ! Seconds per day + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine shr_nuopc_time_clockInit(ensemble_driver, esmdriver, logunit, rc) + + use med_constants_mod , only : CL, CS + use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit + use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_calendarname + + ! input/output variables + type(ESMF_GridComp) :: ensemble_driver, esmdriver + integer, intent(in) :: logunit + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_VM) :: vm + type(ESMF_Time) :: StartTime ! Start time + type(ESMF_Time) :: RefTime ! Reference time + type(ESMF_Time) :: CurrTime ! Current time + type(ESMF_Time) :: StopTime ! Stop time + type(ESMF_Time) :: StopTime1 ! Stop time + type(ESMF_Time) :: StopTime2 ! Stop time + type(ESMF_Time) :: Clocktime ! Loop time + type(ESMF_TimeInterval) :: TimeStep ! Clock time-step + type(ESMF_Calendar) :: calendar ! esmf calendar + type(ESMF_CalKind_Flag) :: caltype ! esmf calendar type + type(ESMF_Alarm) :: alarm_stop ! alarm + type(ESMF_Alarm) :: alarm_datestop ! alarm + integer :: ref_ymd ! Reference date (YYYYMMDD) + integer :: ref_tod ! Reference time of day (seconds) + integer :: start_ymd ! Start date (YYYYMMDD) + integer :: start_tod ! Start time of day (seconds) + integer :: curr_ymd ! Current ymd (YYYYMMDD) + integer :: curr_tod ! Current tod (seconds) + integer :: stop_n ! Number until stop + integer :: stop_ymd ! Stop date (YYYYMMDD) + integer :: stop_tod ! Stop time-of-day + character(CS) :: stop_option ! Stop option units + integer :: atm_cpl_dt ! Atmosphere coupling interval + integer :: lnd_cpl_dt ! Land coupling interval + integer :: ice_cpl_dt ! Sea-Ice coupling interval + integer :: ocn_cpl_dt ! Ocean coupling interval + integer :: glc_cpl_dt ! Glc coupling interval + integer :: rof_cpl_dt ! Runoff coupling interval + integer :: wav_cpl_dt ! Wav coupling interval + integer :: esp_cpl_dt ! Esp coupling interval + character(CS) :: glc_avg_period ! Glc avering coupling period + logical :: read_restart + character(len=CL) :: restart_file + character(len=CL) :: restart_pfile + character(len=CL) :: cvalue + integer :: dtime_drv ! time-step to use + integer :: yr, mon, day ! Year, month, day as integers + integer :: localPet ! local pet in esm domain + logical :: mastertask ! true if mastertask in esm domain + integer :: unitn ! unit number + integer :: ierr ! Return code + character(CL) :: tmpstr ! temporary + character(CS) :: calendar_name ! Calendar name + character(CS) :: inst_suffix + integer :: tmp(6) ! Array for Broadcast + integer :: dbrc + logical :: isPresent + character(len=*), parameter :: subname = '(shr_nuopc_time_clockInit): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + + call ESMF_GridCompGet(esmdriver, vm=vm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! We may want to get the ensemble_driver vm here instead so that + ! files are read on global task 0 only instead of each esm member task 0 + call ESMF_VMGet(vm, localPet=localPet, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + mastertask = localPet == 0 + !--------------------------------------------------------------------------- + ! Create the driver calendar + !--------------------------------------------------------------------------- + + call NUOPC_CompAttributeGet(esmdriver, name="calendar", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + calendar_name = shr_cal_calendarName(cvalue) + + if ( trim(calendar_name) == trim(shr_cal_noleap)) then + caltype = ESMF_CALKIND_NOLEAP + else if ( trim(calendar_name) == trim(shr_cal_gregorian)) then + caltype = ESMF_CALKIND_GREGORIAN + else + call ESMF_LogWrite(trim(subname)//': unrecognized ESMF calendar specified: '//& + trim(calendar_name), ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + end if + + call ESMF_LogWrite(trim(subname)//': driver calendar is : '// trim(calendar_name), & + ESMF_LOGMSG_INFO, rc=rc) + + calendar = ESMF_CalendarCreate( name='CMEPS_'//trim(calendar_name), & + calkindflag=caltype, rc=rc ) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------------------------------------------- + ! Determine clock start time, reference time and current time + !--------------------------------------------------------------------------- + + curr_ymd = 0 + curr_tod = 0 + + call NUOPC_CompAttributeGet(esmdriver, name="start_ymd", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) start_ymd + call NUOPC_CompAttributeGet(esmdriver, name="start_tod", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) start_tod + + call NUOPC_CompAttributeGet(esmdriver, name="ref_ymd", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ref_ymd + call NUOPC_CompAttributeGet(esmdriver, name="ref_tod", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ref_tod + + call NUOPC_CompAttributeGet(esmdriver, name='read_restart', value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) read_restart + + if (read_restart) then + + call NUOPC_CompAttributeGet(esmdriver, name='restart_file', value=restart_file, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--- read rpointer if restart_file is set to str_undefined --- + if (trim(restart_file) == 'str_undefined') then + + ! Error check on restart_pfile + call NUOPC_CompAttributeGet(esmdriver, name="restart_pfile", value=restart_pfile, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(esmdriver, name="inst_suffix", isPresent=isPresent, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if(isPresent) then + call NUOPC_CompAttributeGet(esmdriver, name="inst_suffix", value=inst_suffix, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else + inst_suffix = "" + endif + if ( len_trim(restart_pfile) == 0 ) then + rc = ESMF_FAILURE + call ESMF_LogWrite(trim(subname)//' ERROR restart_pfile must be defined', & + ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=dbrc) + return + end if + restart_pfile = trim(restart_pfile)//inst_suffix + if (mastertask) then + unitn = shr_file_getUnit() + call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), & + ESMF_LOGMSG_INFO, rc=dbrc) + open(unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) + if (ierr < 0) then + rc = ESMF_FAILURE + call ESMF_LogWrite(trim(subname)//' ERROR rpointer file open returns error', & + ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=dbrc) + return + end if + read(unitn,'(a)', iostat=ierr) restart_file + if (ierr < 0) then + rc = ESMF_FAILURE + call ESMF_LogWrite(trim(subname)//' ERROR rpointer file read returns error', & + ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=dbrc) + return + end if + close(unitn) + call shr_file_freeUnit( unitn ) + call ESMF_LogWrite(trim(subname)//" read driver restart from file = "//trim(restart_file), & + ESMF_LOGMSG_INFO, rc=dbrc) + endif + endif + if (mastertask) then + call shr_nuopc_time_read_restart_calendar_settings(restart_file, & + start_ymd, start_tod, ref_ymd, ref_tod, curr_ymd, curr_tod) + endif + tmp(1) = start_ymd + tmp(2) = start_tod + tmp(3) = ref_ymd + tmp(4) = ref_tod + tmp(5) = curr_ymd + tmp(6) = curr_tod + call ESMF_VMBroadcast(vm, tmp, 6, 0, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + start_ymd = tmp(1) + start_tod = tmp(2) + ref_ymd = tmp(3) + ref_tod = tmp(4) + curr_ymd = tmp(5) + curr_tod = tmp(6) + end if + + if ( ref_ymd == 0 ) then + ref_ymd = start_ymd + ref_tod = start_tod + endif + if ( curr_ymd == 0 ) then + curr_ymd = start_ymd + curr_tod = start_tod + endif + + ! Determine start time + call shr_nuopc_time_date2ymd(start_ymd, yr, mon, day) + call ESMF_TimeSet( StartTime, yy=yr, mm=mon, dd=day, s=start_tod, calendar=calendar, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if(mastertask .or. dbug_flag > 2) then + write(tmpstr,'(i10)') start_ymd + call ESMF_LogWrite(trim(subname)//': driver start_ymd: '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(logunit,*) trim(subname)//': driver start_ymd: '// trim(tmpstr) + write(tmpstr,'(i10)') start_tod + call ESMF_LogWrite(trim(subname)//': driver start_tod: '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(logunit,*) trim(subname)//': driver start_tod: '// trim(tmpstr) + endif + + ! Determine reference time + call shr_nuopc_time_date2ymd(ref_ymd, yr, mon, day) + call ESMF_TimeSet( RefTime, yy=yr, mm=mon, dd=day, s=ref_tod, calendar=calendar, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if(mastertask .or. dbug_flag > 2) then + write(tmpstr,'(i10)') ref_ymd + call ESMF_LogWrite(trim(subname)//': driver ref_ymd: '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(logunit,*) trim(subname)//': driver ref_ymd: '// trim(tmpstr) + write(tmpstr,'(i10)') ref_tod + call ESMF_LogWrite(trim(subname)//': driver ref_tod: '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(logunit,*) trim(subname)//': driver ref_tod: '// trim(tmpstr) + endif + ! Determine current time + call shr_nuopc_time_date2ymd(curr_ymd, yr, mon, day) + call ESMF_TimeSet( CurrTime, yy=yr, mm=mon, dd=day, s=curr_tod, calendar=calendar, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if(mastertask .or. dbug_flag > 2) then + write(tmpstr,'(i10)') curr_ymd + call ESMF_LogWrite(trim(subname)//': driver curr_ymd: '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(logunit,*) trim(subname)//': driver curr_ymd: '// trim(tmpstr) + write(tmpstr,'(i10)') curr_tod + call ESMF_LogWrite(trim(subname)//': driver curr_tod: '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(logunit,*) trim(subname)//': driver curr_tod: '// trim(tmpstr) + endif + !--------------------------------------------------------------------------- + ! Determine driver clock timestep + !--------------------------------------------------------------------------- + + call NUOPC_CompAttributeGet(esmdriver, name="atm_cpl_dt", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) atm_cpl_dt + + call NUOPC_CompAttributeGet(esmdriver, name="lnd_cpl_dt", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) lnd_cpl_dt + + call NUOPC_CompAttributeGet(esmdriver, name="ice_cpl_dt", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ice_cpl_dt + + call NUOPC_CompAttributeGet(esmdriver, name="ocn_cpl_dt", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ocn_cpl_dt + + call NUOPC_CompAttributeGet(esmdriver, name="glc_cpl_dt", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) glc_cpl_dt + + call NUOPC_CompAttributeGet(esmdriver, name="rof_cpl_dt", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) rof_cpl_dt + + call NUOPC_CompAttributeGet(esmdriver, name="wav_cpl_dt", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) wav_cpl_dt + + call NUOPC_CompAttributeGet(esmdriver, name="glc_avg_period", value=glc_avg_period, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) glc_avg_period + + ! TODO: for now - this is not in the namelist_definition_drv.xml file + ! call NUOPC_CompAttributeGet(esmdriver, name="esp_cpl_dt", value=cvalue, rc=rc) + ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) esp_cpl_dt + esp_cpl_dt = 9999 + + dtime_drv = 9999 + dtime_drv = min(dtime_drv, atm_cpl_dt) + dtime_drv = min(dtime_drv, lnd_cpl_dt) + dtime_drv = min(dtime_drv, ocn_cpl_dt) + dtime_drv = min(dtime_drv, ice_cpl_dt) + dtime_drv = min(dtime_drv, glc_cpl_dt) + dtime_drv = min(dtime_drv, rof_cpl_dt) + dtime_drv = min(dtime_drv, wav_cpl_dt) + dtime_drv = min(dtime_drv, esp_cpl_dt) + if(mastertask .or. dbug_flag > 2) then + write(tmpstr,'(i10)') dtime_drv + call ESMF_LogWrite(trim(subname)//': driver time interval is : '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + write(logunit,*) trim(subname)//': driver time interval is : '// trim(tmpstr) + endif + call ESMF_TimeIntervalSet( TimeStep, s=dtime_drv, rc=rc ) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------------------------------------------- + ! Create the driver clock with an artificial stop time + !--------------------------------------------------------------------------- + + ! Create the clock + clock = ESMF_ClockCreate(TimeStep, StartTime, refTime=RefTime, name='ESMF Driver Clock', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Advance the clock to the current time (in case of a restart) + call ESMF_ClockGet(clock, currTime=clocktime, rc=rc ) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + do while( clocktime < CurrTime) + call ESMF_ClockAdvance( clock, rc=rc ) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet( clock, currTime=clocktime, rc=rc ) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + ! Set the driver gridded component clock to the created clock + call ESMF_GridCompSet(esmdriver, clock=clock, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------------------- + ! Set driver clock stop time + !------------------------------- + + call NUOPC_CompAttributeGet(esmdriver, name="stop_option", value=stop_option, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(esmdriver, name="stop_n", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) stop_n + call NUOPC_CompAttributeGet(esmdriver, name="stop_ymd", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) stop_ymd + call NUOPC_CompAttributeGet(esmdriver, name="stop_tod", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) stop_tod + if ( stop_ymd < 0) then + stop_ymd = 99990101 + stop_tod = 0 + endif + if(mastertask .or. dbug_flag > 2) then + write(tmpstr,'(i10)') stop_ymd + call ESMF_LogWrite(trim(subname)//': driver stop_ymd: '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(logunit,*) trim(subname)//': driver stop_ymd: '// trim(tmpstr) + write(tmpstr,'(i10)') stop_tod + call ESMF_LogWrite(trim(subname)//': driver stop_tod: '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(logunit,*) trim(subname)//': driver stop_tod: '// trim(tmpstr) + endif + call shr_nuopc_time_alarmInit(clock, & + alarm = alarm_stop, & + option = stop_option, & + opt_n = stop_n, & + opt_ymd = stop_ymd, & + opt_tod = stop_tod, & + RefTime = CurrTime, & + alarmname = 'alarm_stop', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_time_alarmInit(clock, & + alarm = alarm_datestop, & + option = optDate, & + opt_ymd = stop_ymd, & + opt_tod = stop_tod, & + RefTime = StartTime, & + alarmname = 'alarm_datestop', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_AlarmGet(alarm_stop, RingTime=StopTime1, rc=rc ) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AlarmGet(alarm_datestop, RingTime=StopTime2, rc=rc ) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (StopTime2 < StopTime1) then + StopTime = StopTime2 + else + StopTime = StopTime1 + endif + + call ESMF_ClockSet(clock, StopTime=StopTime, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create the ensemble driver clock + TimeStep = StopTime-ClockTime + clock = ESMF_ClockCreate(TimeStep, ClockTime, StopTime=StopTime, & + refTime=RefTime, name='ESMF ensemble Driver Clock', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_GridCompSet(ensemble_driver, clock=clock, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + + + end subroutine shr_nuopc_time_clockInit + + subroutine shr_nuopc_time_set_component_stop_alarm(gcomp, rc) + use ESMF, only : ESMF_GridComp, ESMF_Alarm, ESMF_Clock, ESMF_ClockGet + use ESMF, only : ESMF_AlarmSet + use NUOPC, only : NUOPC_CompAttributeGet + use NUOPC_Model, only : NUOPC_ModelGet + type(ESMF_gridcomp) :: gcomp + + character(len=256) :: stop_option ! Stop option units + integer :: stop_n ! Number until stop interval + integer :: stop_ymd ! Stop date (YYYYMMDD) + type(ESMF_ALARM) :: stop_alarm + character(len=256) :: cvalue + type(ESMF_Clock) :: mclock + type(ESMF_Time) :: mCurrTime + integer :: rc + !---------------- + ! Stop alarm + !---------------- + call NUOPC_CompAttributeGet(gcomp, name="stop_option", value=stop_option, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(mclock, CurrTime=mCurrTime, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp, name="stop_n", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) stop_n + + call NUOPC_CompAttributeGet(gcomp, name="stop_ymd", value=cvalue, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) stop_ymd + call shr_nuopc_time_alarmInit(mclock, stop_alarm, stop_option, & + opt_n = stop_n, & + opt_ymd = stop_ymd, & + RefTime = mcurrTime, & + alarmname = 'alarm_stop', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_AlarmSet(stop_alarm, clock=mclock, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine shr_nuopc_time_set_component_stop_alarm + +!=============================================================================== + + subroutine shr_nuopc_time_alarmInit( clock, alarm, option, & + opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) + + ! !DESCRIPTION: Setup an alarm in a clock + ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm + ! time. If you send an arbitrary but proper ringtime from the + ! past and the ring interval, the alarm will always go off on the + ! next clock advance and this will cause serious problems. Even + ! if it makes sense to initialize an alarm with some reference + ! time and the alarm interval, that reference time has to be + ! advance forward to be >= the current time. In the logic below + ! we set an appropriate "NextAlarm" and then we make sure to + ! advance it properly based on the ring interval. + + ! input/output variables + type(ESMF_Clock) , intent(inout) :: clock ! clock + type(ESMF_Alarm) , intent(inout) :: alarm ! alarm + character(len=*) , intent(in) :: option ! alarm option + integer , optional , intent(in) :: opt_n ! alarm freq + integer , optional , intent(in) :: opt_ymd ! alarm ymd + integer , optional , intent(in) :: opt_tod ! alarm tod (sec) + type(ESMF_Time) , optional , intent(in) :: RefTime ! ref time + character(len=*) , optional , intent(in) :: alarmname ! alarm name + integer , intent(inout) :: rc ! Return code + + ! local variables + type(ESMF_Calendar) :: cal ! calendar + integer :: lymd ! local ymd + integer :: ltod ! local tod + integer :: cyy,cmm,cdd,csec ! time info + character(len=64) :: lalarmname ! local alarm name + logical :: update_nextalarm ! update next alarm + type(ESMF_Time) :: CurrTime ! Current Time + type(ESMF_Time) :: NextAlarm ! Next restart alarm time + type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval + integer :: sec + character(len=*), parameter :: subname = '(shr_nuopc_time_alarmInit): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lalarmname = 'alarm_unknown' + if (present(alarmname)) lalarmname = trim(alarmname) + ltod = 0 + if (present(opt_tod)) ltod = opt_tod + lymd = -1 + if (present(opt_ymd)) lymd = opt_ymd + + call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! initial guess of next alarm, this will be updated below + if (present(RefTime)) then + NextAlarm = RefTime + else + NextAlarm = CurrTime + endif + + ! Determine calendar + call ESMF_ClockGet(clock, calendar=cal) + + ! Determine inputs for call to create alarm + selectcase (trim(option)) + + case (optNONE) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optNever) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optDate) + if (.not. present(opt_ymd)) then + call shr_nuopc_abort(subname//trim(option)//' requires opt_ymd') + end if + if (lymd < 0 .or. ltod < 0) then + call shr_nuopc_abort(subname//trim(option)//'opt_ymd, opt_tod invalid') + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_time_timeInit(NextAlarm, lymd, cal, tod=ltod, desc="optDate") + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optIfdays0) + if (.not. present(opt_ymd)) then + call shr_nuopc_abort(subname//trim(option)//' requires opt_ymd') + end if + if (.not.present(opt_n)) then + call shr_nuopc_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_nuopc_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=opt_n, s=0, calendar=cal, rc=rc ) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + case (optNSteps) + if (.not.present(opt_n)) then + call shr_nuopc_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_nuopc_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNStep) + if (.not.present(opt_n)) call shr_nuopc_abort(subname//trim(option)//' requires opt_n') + if (opt_n <= 0) call shr_nuopc_abort(subname//trim(option)//' invalid opt_n') + call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNSeconds) + if (.not.present(opt_n)) then + call shr_nuopc_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_nuopc_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNSecond) + if (.not.present(opt_n)) then + call shr_nuopc_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_nuopc_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMinutes) + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + if (.not.present(opt_n)) then + call shr_nuopc_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_nuopc_abort(subname//trim(option)//' invalid opt_n') + end if + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMinute) + if (.not.present(opt_n)) then + call shr_nuopc_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_nuopc_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNHours) + if (.not.present(opt_n)) then + call shr_nuopc_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_nuopc_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNHour) + if (.not.present(opt_n)) then + call shr_nuopc_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_nuopc_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNDays) + if (.not.present(opt_n)) then + call shr_nuopc_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_nuopc_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNDay) + if (.not.present(opt_n)) then + call shr_nuopc_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_nuopc_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMonths) + if (.not.present(opt_n)) then + call shr_nuopc_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_nuopc_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMonth) + if (.not.present(opt_n)) then + call shr_nuopc_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_nuopc_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optMonthly) + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + case (optNYears) + if (.not.present(opt_n)) then + call shr_nuopc_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_nuopc_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNYear) + if (.not.present(opt_n)) then + call shr_nuopc_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_nuopc_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optYearly) + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + case default + call shr_nuopc_abort(subname//'unknown option '//trim(option)) + + end select + + ! -------------------------------------------------------------------------------- + ! --- AlarmInterval and NextAlarm should be set --- + ! -------------------------------------------------------------------------------- + + ! --- advance Next Alarm so it won't ring on first timestep for + ! --- most options above. go back one alarminterval just to be careful + + if (update_nextalarm) then + NextAlarm = NextAlarm - AlarmInterval + do while (NextAlarm <= CurrTime) + NextAlarm = NextAlarm + AlarmInterval + enddo + endif + + alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & + ringInterval=AlarmInterval, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine shr_nuopc_time_alarmInit + + !=============================================================================== + + subroutine shr_nuopc_time_timeInit( Time, ymd, cal, tod, desc, logunit ) + + ! Create the ESMF_Time object corresponding to the given input time, given in + ! YMD (Year Month Day) and TOD (Time-of-day) format. + ! Set the time by an integer as YYYYMMDD and integer seconds in the day + + ! input/output parameters: + type(ESMF_Time) , intent(inout) :: Time ! ESMF time + integer , intent(in) :: ymd ! year, month, day YYYYMMDD + type(ESMF_Calendar) , intent(in) :: cal ! ESMF calendar + integer , intent(in), optional :: tod ! time of day in seconds + character(len=*) , intent(in), optional :: desc ! description of time to set + integer , intent(in), optional :: logunit + + ! local variables + integer :: yr, mon, day ! Year, month, day as integers + integer :: ltod ! local tod + character(len=256) :: ldesc ! local desc + integer :: rc ! return code + character(len=*), parameter :: subname = '(shr_nuopc_time_m_ETimeInit) ' + !------------------------------------------------------------------------------- + + ltod = 0 + if (present(tod)) ltod = tod + ldesc = '' + if (present(desc)) ldesc = desc + + if ( (ymd < 0) .or. (ltod < 0) .or. (ltod > SecPerDay) )then + if (present(logunit)) then + write(logunit,*) subname//': ERROR yymmdd is a negative number or '// & + 'time-of-day out of bounds', ymd, ltod + end if + call shr_nuopc_abort( subname//'ERROR: Bad input' ) + end if + + call shr_nuopc_time_date2ymd (ymd,yr,mon,day) + + call ESMF_TimeSet( Time, yy=yr, mm=mon, dd=day, s=ltod, calendar=cal, rc=rc ) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine shr_nuopc_time_timeInit + + !=============================================================================== + + subroutine shr_nuopc_time_date2ymd (date, year, month, day) + + ! input/output variables + integer, intent(in) :: date ! coded-date (yyyymmdd) + integer, intent(out) :: year,month,day ! calendar year,month,day + + ! local variables + integer :: tdate ! temporary date + character(*),parameter :: subName = "(shr_nuopc_time_date2ymd)" + !------------------------------------------------------------------------------- + + tdate = abs(date) + year = int(tdate/10000) + if (date < 0) then + year = -year + end if + month = int( mod(tdate,10000)/ 100) + day = mod(tdate, 100) + + end subroutine shr_nuopc_time_date2ymd + + subroutine shr_nuopc_time_read_restart_calendar_settings(restart_file, & + start_ymd, start_tod, ref_ymd, ref_tod, curr_ymd, curr_tod) + + use netcdf , only : nf90_open, nf90_nowrite, nf90_noerr + use netcdf , only : nf90_inq_varid, nf90_get_var, nf90_close + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO + use med_constants_mod , only : CL + + character(len=*), intent(in) :: restart_file + integer, intent(out) :: ref_ymd ! Reference date (YYYYMMDD) + integer, intent(out) :: ref_tod ! Reference time of day (seconds) + integer, intent(out) :: start_ymd ! Start date (YYYYMMDD) + integer, intent(out) :: start_tod ! Start time of day (seconds) + integer, intent(out) :: curr_ymd ! Current ymd (YYYYMMDD) + integer, intent(out) :: curr_tod ! Current tod (seconds) + + integer :: status, ncid, varid ! netcdf stuff + integer :: dbrc ! error codes + character(CL) :: tmpstr ! temporary + character(len=*), parameter :: subname = "(shr_nuopc_time_read_restart_calendar_settings)" + + ! use netcdf here since it's serial + status = nf90_open(restart_file, NF90_NOWRITE, ncid) + if (status /= nf90_NoErr) then + print *,__FILE__,__LINE__,trim(restart_file) + call shr_nuopc_abort(trim(subname)//' ERROR: nf90_open') + endif + status = nf90_inq_varid(ncid, 'start_ymd', varid) + if (status /= nf90_NoErr) call shr_nuopc_abort(trim(subname)//' ERROR: nf90_inq_varid start_ymd') + status = nf90_get_var(ncid, varid, start_ymd) + if (status /= nf90_NoErr) call shr_nuopc_abort(trim(subname)//' ERROR: nf90_get_var start_ymd') + status = nf90_inq_varid(ncid, 'start_tod', varid) + if (status /= nf90_NoErr) call shr_nuopc_abort(trim(subname)//' ERROR: nf90_inq_varid start_tod') + status = nf90_get_var(ncid, varid, start_tod) + if (status /= nf90_NoErr) call shr_nuopc_abort(trim(subname)//' ERROR: nf90_get_var start_tod') + status = nf90_inq_varid(ncid, 'ref_ymd', varid) + if (status /= nf90_NoErr) call shr_nuopc_abort(trim(subname)//' ERROR: nf90_inq_varid ref_ymd') + status = nf90_get_var(ncid, varid, ref_ymd) + if (status /= nf90_NoErr) call shr_nuopc_abort(trim(subname)//' ERROR: nf90_get_var ref_ymd') + status = nf90_inq_varid(ncid, 'ref_tod', varid) + if (status /= nf90_NoErr) call shr_nuopc_abort(trim(subname)//' ERROR: nf90_inq_varid ref_tod') + status = nf90_get_var(ncid, varid, ref_tod) + if (status /= nf90_NoErr) call shr_nuopc_abort(trim(subname)//' ERROR: nf90_get_var ref_tod') + status = nf90_inq_varid(ncid, 'curr_ymd', varid) + if (status /= nf90_NoErr) call shr_nuopc_abort(trim(subname)//' ERROR: nf90_inq_varid curr_ymd') + status = nf90_get_var(ncid, varid, curr_ymd) + if (status /= nf90_NoErr) call shr_nuopc_abort(trim(subname)//' ERROR: nf90_get_var curr_ymd') + status = nf90_inq_varid(ncid, 'curr_tod', varid) + if (status /= nf90_NoErr) call shr_nuopc_abort(trim(subname)//' ERROR: nf90_inq_varid curr_tod') + status = nf90_get_var(ncid, varid, curr_tod) + if (status /= nf90_NoErr) call shr_nuopc_abort(trim(subname)//' ERROR: nf90_get_var curr_tod') + status = nf90_close(ncid) + if (status /= nf90_NoErr) call shr_nuopc_abort(trim(subname)//' ERROR: nf90_close') + + write(tmpstr,*) trim(subname)//" read start_ymd = ",start_ymd + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(tmpstr,*) trim(subname)//" read start_tod = ",start_tod + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(tmpstr,*) trim(subname)//" read ref_ymd = ",ref_ymd + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(tmpstr,*) trim(subname)//" read ref_tod = ",ref_tod + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(tmpstr,*) trim(subname)//" read curr_ymd = ",curr_ymd + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(tmpstr,*) trim(subname)//" read curr_tod = ",curr_tod + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + end subroutine shr_nuopc_time_read_restart_calendar_settings + +end module shr_nuopc_time_mod diff --git a/src/shr/shr_nuopc_utils_mod.F90 b/src/shr/shr_nuopc_utils_mod.F90 new file mode 100644 index 00000000..8d3b30f0 --- /dev/null +++ b/src/shr/shr_nuopc_utils_mod.F90 @@ -0,0 +1,137 @@ +module shr_nuopc_utils_mod + + use shr_sys_mod , only : shr_nuopc_abort => shr_sys_abort + use shr_string_mod , only : shr_nuopc_string_listGetName => shr_string_listGetName + + implicit none + private + public :: shr_nuopc_abort, shr_nuopc_string_listGetName + public :: shr_nuopc_memcheck + public :: shr_nuopc_get_component_instance + public :: shr_nuopc_set_component_logging + public :: shr_nuopc_utils_ChkErr + public :: shr_nuopc_log_clock_advance + + integer, parameter :: memdebug_level=1 + character(*),parameter :: u_FILE_u = __FILE__ + +contains + subroutine shr_nuopc_memcheck(string, level, mastertask) + character(len=*), intent(in) :: string + integer, intent(in) :: level + logical, intent(in) :: mastertask + integer :: ierr + integer, external :: GPTLprint_memusage + if((mastertask .and. memdebug_level > level) .or. memdebug_level > level+1) then + ierr = GPTLprint_memusage(string) + endif + end subroutine shr_nuopc_memcheck + + subroutine shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) + use ESMF, only : ESMF_SUCCESS, ESMF_GridComp + use NUOPC, only : NUOPC_CompAttributeGet + + type(ESMF_GridComp) :: gcomp + character(len=*), intent(out) :: inst_suffix + integer, intent(out) :: inst_index + integer :: rc + logical :: isPresent + character(len=4) :: cvalue + + call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", isPresent=isPresent, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", value=inst_suffix, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + cvalue = inst_suffix(2:) + read(cvalue, *) inst_index + else + inst_suffix = "" + inst_index=1 + endif + + end subroutine shr_nuopc_get_component_instance + + subroutine shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit, shrloglev) + use ESMF, only : ESMF_GridComp, ESMF_VM, ESMF_VMGet, ESMF_GridCompGet + use NUOPC, only : NUOPC_CompAttributeGet + use med_constants_mod, only : shr_file_getunit, shr_file_getLogUnit, shr_file_getLogLevel + use med_constants_mod, only : shr_file_setLogLevel, CL, shr_file_setlogunit + + type(ESMF_GridComp) :: gcomp + logical, intent(in) :: mastertask + integer, intent(out) :: logunit + integer, intent(out) :: shrlogunit + integer, intent(out) :: shrloglev + + character(len=CL) :: diro + character(len=CL) :: logfile + integer :: rc + shrlogunit = 6 + if (mastertask) then + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) + else + logUnit = 6 + endif + call shr_file_setLogUnit (logunit) + end subroutine shr_nuopc_set_component_logging + + logical function shr_nuopc_utils_ChkErr(rc, line, file, mpierr) + use mpi , only : MPI_ERROR_STRING, MPI_MAX_ERROR_STRING, MPI_SUCCESS + use ESMF, only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO + use ESMF, only : ESMF_FAILURE, ESMF_LogWrite + integer, intent(in) :: rc + integer, intent(in) :: line + + character(len=*), intent(in) :: file + logical, optional, intent(in) :: mpierr + + character(MPI_MAX_ERROR_STRING) :: lstring + integer :: dbrc, lrc, len, ierr + + shr_nuopc_utils_ChkErr = .false. + lrc = rc + if (present(mpierr) .and. mpierr) then + if (rc == MPI_SUCCESS) return + call MPI_ERROR_STRING(rc, lstring, len, ierr) + call ESMF_LogWrite("ERROR: "//trim(lstring), ESMF_LOGMSG_INFO, line=line, file=file, rc=dbrc) + lrc = ESMF_FAILURE + endif + + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then + shr_nuopc_utils_ChkErr = .true. + endif + + end function shr_nuopc_utils_ChkErr + + !----------------------------------------------------------------------------- + subroutine shr_nuopc_log_clock_advance(clock, component, logunit) + use ESMF, only : ESMF_Clock, ESMF_ClockPrint + use med_constants_mod, only : CL + + type(ESMF_Clock) :: clock + character(len=*), intent(in) :: component + integer, intent(in) :: logunit + + character(len=CL) :: cvalue, prestring + integer :: rc + + write(prestring, *) "------>Advancing ",trim(component)," from: " + call ESMF_ClockPrint(clock, options="currTime", unit=cvalue, & + preString=trim(prestring), rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write(logunit, *) trim(cvalue) + + call ESMF_ClockPrint(clock, options="stopTime", unit=cvalue, & + preString="--------------------------------> to: ", rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write(logunit, *) trim(cvalue) + + end subroutine shr_nuopc_log_clock_advance + + +end module shr_nuopc_utils_mod diff --git a/src/shr_flds/glc_elevclass_mod.F90 b/src/shr_flds/glc_elevclass_mod.F90 new file mode 100644 index 00000000..4df66246 --- /dev/null +++ b/src/shr_flds/glc_elevclass_mod.F90 @@ -0,0 +1,431 @@ +module glc_elevclass_mod + + !--------------------------------------------------------------------- + ! + ! Purpose: + ! + ! This module contains data and routines for operating on GLC elevation classes. + !--------------------------------------------------------------------- + +#include "shr_assert.h" + use med_constants_mod , only : R8 + use shr_sys_mod , only : shr_sys_abort + + implicit none + private + + !-------------------------------------------------------------------------- + ! Public interfaces + !-------------------------------------------------------------------------- + + public :: glc_elevclass_init ! initialize GLC elevation class data + public :: glc_elevclass_clean ! deallocate memory allocated here + public :: glc_get_num_elevation_classes ! get the number of elevation classes + public :: glc_get_elevation_class ! get the elevation class index for a given elevation + public :: glc_get_elevclass_bounds ! get the boundaries of all elevation classes + public :: glc_mean_elevation_virtual ! get the mean elevation of a virtual elevation class + public :: glc_elevclass_as_string ! returns a string corresponding to a given elevation class + public :: glc_all_elevclass_strings ! returns an array of strings for all elevation classes + public :: glc_errcode_to_string ! convert an error code into a string describing the error + + interface glc_elevclass_init + module procedure glc_elevclass_init_default + module procedure glc_elevclass_init_override + end interface glc_elevclass_init + + + !-------------------------------------------------------------------------- + ! Public data + !-------------------------------------------------------------------------- + + ! Possible error code values + integer, parameter, public :: GLC_ELEVCLASS_ERR_NONE = 0 ! err_code indicating no error + integer, parameter, public :: GLC_ELEVCLASS_ERR_UNDEFINED = 1 ! err_code indicating elevation classes have not been defined + integer, parameter, public :: GLC_ELEVCLASS_ERR_TOO_LOW = 2 ! err_code indicating topo below lowest elevation class + integer, parameter, public :: GLC_ELEVCLASS_ERR_TOO_HIGH = 3 ! err_code indicating topo above highest elevation class + + ! String length for glc elevation classes represented as strings + integer, parameter, public :: GLC_ELEVCLASS_STRLEN = 2 + + !-------------------------------------------------------------------------- + ! Private data + !-------------------------------------------------------------------------- + + ! number of elevation classes + integer :: glc_nec + + ! upper elevation limit of each class (m) + ! indexing starts at 0, with topomax(0) giving the lower elevation limit of EC 1 + real(r8), allocatable :: topomax(:) + + +contains + + !----------------------------------------------------------------------- + subroutine glc_elevclass_init_default(my_glc_nec, logunit) + ! + ! !DESCRIPTION: + ! Initialize GLC elevation class data to default boundaries, based on given glc_nec + ! + ! !USES: + ! + ! !ARGUMENTS: + integer, intent(in) :: my_glc_nec ! number of GLC elevation classes + integer, intent(in), optional :: logunit + ! + ! !LOCAL VARIABLES: + character(len=*), parameter :: subname = 'glc_elevclass_init' + !----------------------------------------------------------------------- + + glc_nec = my_glc_nec + allocate(topomax(0:glc_nec)) + + select case (glc_nec) + case(0) + ! do nothing + case(1) + topomax = [0._r8, 10000._r8] + case(3) + topomax = [0._r8, 1000._r8, 2000._r8, 10000._r8] + case(5) + topomax = [0._r8, 500._r8, 1000._r8, 1500._r8, 2000._r8, 10000._r8] + case(10) + topomax = [0._r8, 200._r8, 400._r8, 700._r8, 1000._r8, 1300._r8, & + 1600._r8, 2000._r8, 2500._r8, 3000._r8, 10000._r8] + case(36) + topomax = [ 0._r8, 200._r8, 400._r8, 600._r8, 800._r8, & + 1000._r8, 1200._r8, 1400._r8, 1600._r8, 1800._r8, & + 2000._r8, 2200._r8, 2400._r8, 2600._r8, 2800._r8, & + 3000._r8, 3200._r8, 3400._r8, 3600._r8, 3800._r8, & + 4000._r8, 4200._r8, 4400._r8, 4600._r8, 4800._r8, & + 5000._r8, 5200._r8, 5400._r8, 5600._r8, 5800._r8, & + 6000._r8, 6200._r8, 6400._r8, 6600._r8, 6800._r8, & + 7000._r8, 10000._r8] + case default + if (present(logunit)) then + write(logunit,*) subname,' ERROR: unknown glc_nec: ', glc_nec + end if + call shr_sys_abort(subname//' ERROR: unknown glc_nec') + end select + + end subroutine glc_elevclass_init_default + + !----------------------------------------------------------------------- + subroutine glc_elevclass_init_override(my_glc_nec, my_topomax) + ! + ! !DESCRIPTION: + ! Initialize GLC elevation class data to the given elevation class boundaries. + ! + ! The input, my_topomax, should have (my_glc_nec + 1) elements. + ! + ! !USES: + ! + ! !ARGUMENTS: + integer, intent(in) :: my_glc_nec ! number of GLC elevation classes + real(r8), intent(in) :: my_topomax(0:) ! elevation class boundaries (m) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'glc_elevclass_init_override' + !----------------------------------------------------------------------- + + SHR_ASSERT_ALL_FL((ubound(my_topomax) == (/my_glc_nec/)), __FILE__, __LINE__) + + glc_nec = my_glc_nec + allocate(topomax(0:glc_nec)) + topomax = my_topomax + + end subroutine glc_elevclass_init_override + + !----------------------------------------------------------------------- + subroutine glc_elevclass_clean() + ! + ! !DESCRIPTION: + ! Deallocate memory allocated in this module + + character(len=*), parameter :: subname = 'glc_elevclass_clean' + !----------------------------------------------------------------------- + + if (allocated(topomax)) then + deallocate(topomax) + end if + glc_nec = 0 + + end subroutine glc_elevclass_clean + + !----------------------------------------------------------------------- + function glc_get_num_elevation_classes() result(num_elevation_classes) + ! + ! !DESCRIPTION: + ! Get the number of GLC elevation classes + ! + ! !ARGUMENTS: + integer :: num_elevation_classes ! function result + integer :: rc + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'glc_get_num_elevation_classes' + !----------------------------------------------------------------------- + + num_elevation_classes = glc_nec + + end function glc_get_num_elevation_classes + + !----------------------------------------------------------------------- + subroutine glc_get_elevation_class(topo, elevation_class, err_code) + ! + ! !DESCRIPTION: + ! Get the elevation class index associated with a given topographic height. + ! + ! The returned elevation_class will be between 1 and num_elevation_classes, if this + ! topographic height is contained in an elevation class. In this case, err_code will + ! be GLC_ELEVCLASS_ERR_NONE (no error). + ! + ! If there are no elevation classes defined, the returned value will be 0, and + ! err_code will be GLC_ELEVCLASS_ERR_UNDEFINED + ! + ! If this topographic height is below the lowest elevation class, the returned value + ! will be 1, and err_code will be GLC_ELEVCLASS_ERR_TOO_LOW. + ! + ! If this topographic height is above the highest elevation class, the returned value + ! will be (num_elevation_classes), and err_code will be GLC_ELEVCLASS_ERR_TOO_HIGH. + ! + ! !USES: + ! + ! !ARGUMENTS: + real(r8), intent(in) :: topo ! topographic height (m) + integer, intent(out) :: elevation_class ! elevation class index + integer, intent(out) :: err_code ! error code (see above for possible codes) + ! + ! !LOCAL VARIABLES: + integer :: ec ! temporary elevation class + + character(len=*), parameter :: subname = 'glc_get_elevation_class' + !----------------------------------------------------------------------- + + if (glc_nec < 1) then + elevation_class = 0 + err_code = GLC_ELEVCLASS_ERR_UNDEFINED + else if (topo < topomax(0)) then + elevation_class = 1 + err_code = GLC_ELEVCLASS_ERR_TOO_LOW + else if (topo >= topomax(glc_nec)) then + elevation_class = glc_nec + err_code = GLC_ELEVCLASS_ERR_TOO_HIGH + else + err_code = GLC_ELEVCLASS_ERR_NONE + elevation_class = 0 + do ec = 1, glc_nec + if (topo >= topomax(ec - 1) .and. topo < topomax(ec)) then + elevation_class = ec + exit + end if + end do + + SHR_ASSERT(elevation_class > 0, subname//' elevation class was not assigned') + end if + + end subroutine glc_get_elevation_class + + !----------------------------------------------------------------------- + function glc_get_elevclass_bounds() result(elevclass_bounds) + ! + ! !DESCRIPTION: + ! Get the boundaries of all elevation classes. + ! + ! This returns an array of size glc_nec+1, since it contains both the lower and upper + ! bounds of each elevation class. + ! + ! !USES: + ! + ! !ARGUMENTS: + real(r8) :: elevclass_bounds(0:glc_nec) ! function result + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'glc_get_elevclass_bounds' + !----------------------------------------------------------------------- + + elevclass_bounds(:) = topomax(:) + + end function glc_get_elevclass_bounds + + + !----------------------------------------------------------------------- + function glc_mean_elevation_virtual(elevation_class, logunit) result(mean_elevation) + ! + ! !DESCRIPTION: + ! Returns the mean elevation of a virtual elevation class + ! + ! !ARGUMENTS: + real(r8) :: mean_elevation ! function result + integer, intent(in) :: elevation_class + integer, optional, intent(in) :: logunit + ! + ! !LOCAL VARIABLES: + integer :: resulting_elevation_class + integer :: err_code + + character(len=*), parameter :: subname = 'glc_mean_elevation_virtual' + !----------------------------------------------------------------------- + + if (elevation_class == 0) then + ! Bare land "elevation class" + mean_elevation = 0._r8 + else + if (elevation_class < glc_nec) then + ! Normal case + mean_elevation = (topomax(elevation_class - 1) + topomax(elevation_class)) / 2._r8 + else if (elevation_class == glc_nec) then + ! In the top elevation class; in this case, assignment of a "mean" elevation is + ! somewhat arbitrary (because we expect the upper bound of the top elevation + ! class to be very high). + + if (glc_nec > 1) then + mean_elevation = 2._r8 * topomax(elevation_class - 1) - topomax(elevation_class - 2) + else + ! entirely arbitrary + mean_elevation = 1000._r8 + end if + else + if (present(logunit)) then + write(logunit,*) subname,' ERROR: elevation class out of bounds: ', elevation_class + end if + call shr_sys_abort(subname // ' ERROR: elevation class out of bounds') + end if + end if + + ! Ensure that the resulting elevation is within the given elevation class + if (elevation_class > 0) then + call glc_get_elevation_class(mean_elevation, resulting_elevation_class, err_code) + if (err_code /= GLC_ELEVCLASS_ERR_NONE) then + if (present(logunit)) then + write(logunit,*) subname, ' ERROR: generated elevation that results in an error' + write(logunit,*) 'when trying to determine the resulting elevation class' + write(logunit,*) glc_errcode_to_string(err_code) + write(logunit,*) 'elevation_class, mean_elevation = ', elevation_class, mean_elevation + end if + call shr_sys_abort(subname // ' ERROR: generated elevation that results in an error') + else if (resulting_elevation_class /= elevation_class) then + if (present(logunit)) then + write(logunit,*) subname, ' ERROR: generated elevation outside the given elevation class' + write(logunit,*) 'elevation_class, mean_elevation, resulting_elevation_class = ', & + elevation_class, mean_elevation, resulting_elevation_class + end if + call shr_sys_abort(subname // ' ERROR: generated elevation outside the given elevation class') + end if + end if + + end function glc_mean_elevation_virtual + + + !----------------------------------------------------------------------- + function glc_elevclass_as_string(elevation_class) result(ec_string) + ! + ! !DESCRIPTION: + ! Returns a string corresponding to a given elevation class. + ! + ! This string can be used as a suffix for fields in MCT attribute vectors. + ! + ! ! NOTE(wjs, 2015-01-19) This function doesn't fully belong in this module, since it + ! doesn't refer to the data stored in this module. However, I can't think of a more + ! appropriate place for it. + ! + ! !USES: + ! + ! !ARGUMENTS: + character(len=GLC_ELEVCLASS_STRLEN) :: ec_string ! function result + integer, intent(in) :: elevation_class + ! + ! !LOCAL VARIABLES: + character(len=16) :: format_string + + character(len=*), parameter :: subname = 'glc_elevclass_as_string' + !----------------------------------------------------------------------- + + ! e.g., for GLC_ELEVCLASS_STRLEN = 2, format_string will be '(i2.2)' + write(format_string,'(a,i0,a,i0,a)') '(i', GLC_ELEVCLASS_STRLEN, '.', GLC_ELEVCLASS_STRLEN, ')' + + write(ec_string,trim(format_string)) elevation_class + end function glc_elevclass_as_string + + !----------------------------------------------------------------------- + function glc_all_elevclass_strings(include_zero) result(ec_strings) + ! + ! !DESCRIPTION: + ! Returns an array of strings corresponding to all elevation classes from 1 to glc_nec + ! + ! If include_zero is present and true, then includes elevation class 0 - so goes from + ! 0 to glc_nec + ! + ! These strings can be used as suffixes for fields in MCT attribute vectors. + ! + ! !USES: + ! + ! !ARGUMENTS: + character(len=GLC_ELEVCLASS_STRLEN), allocatable :: ec_strings(:) ! function result + logical, intent(in), optional :: include_zero ! if present and true, include elevation class 0 (default is false) + ! + ! !LOCAL VARIABLES: + logical :: l_include_zero ! local version of optional include_zero argument + integer :: lower_bound + integer :: i + + character(len=*), parameter :: subname = 'glc_all_elevclass_strings' + !----------------------------------------------------------------------- + + if (present(include_zero)) then + l_include_zero = include_zero + else + l_include_zero = .false. + end if + + if (l_include_zero) then + lower_bound = 0 + else + lower_bound = 1 + end if + + allocate(ec_strings(lower_bound:glc_nec)) + do i = lower_bound, glc_nec + ec_strings(i) = glc_elevclass_as_string(i) + end do + + end function glc_all_elevclass_strings + + + !----------------------------------------------------------------------- + function glc_errcode_to_string(err_code) result(err_string) + ! + ! !DESCRIPTION: + ! + ! + ! !USES: + ! + ! !ARGUMENTS: + character(len=256) :: err_string ! function result + integer, intent(in) :: err_code ! error code (one of the GLC_ELEVCLASS_ERR* values) + ! + ! !LOCAL VARIABLES: + + character(len=*), parameter :: subname = 'glc_errcode_to_string' + !----------------------------------------------------------------------- + + select case (err_code) + case (GLC_ELEVCLASS_ERR_NONE) + err_string = '(no error)' + case (GLC_ELEVCLASS_ERR_UNDEFINED) + err_string = 'Elevation classes have not yet been defined' + case (GLC_ELEVCLASS_ERR_TOO_LOW) + err_string = 'Topographic height below the lower bound of the lowest elevation class' + case (GLC_ELEVCLASS_ERR_TOO_HIGH) + err_string = 'Topographic height above the upper bound of the highest elevation class' + case default + err_string = 'UNKNOWN ERROR' + end select + + end function glc_errcode_to_string + +end module glc_elevclass_mod + diff --git a/src/shr_flds/seq_drydep_mod.F90 b/src/shr_flds/seq_drydep_mod.F90 new file mode 100644 index 00000000..225b561c --- /dev/null +++ b/src/shr_flds/seq_drydep_mod.F90 @@ -0,0 +1,923 @@ +module seq_drydep_mod + + !======================================================================== + ! Module for handling dry depostion of tracers. + ! This module is shared by land and atmosphere models for the computations of + ! dry deposition of tracers + ! + ! !REVISION HISTORY: + ! 2008-Nov-12 - F. Vitt - creation. + ! 2009-Feb-19 - E. Kluzek - merge shr_drydep_tables module in. + ! 2009-Feb-20 - E. Kluzek - use shr_ coding standards, and check for namelist file. + ! 2009-Feb-20 - E. Kluzek - Put _r8 on all constants, remove namelist read out. + ! 2009-Mar-23 - F. Vitt - Some corrections/cleanup and addition of drydep_method. + ! 2009-Mar-27 - E. Kluzek - Get description and units from J.F. Lamarque. + !======================================================================== + + ! !USES: + + use shr_sys_mod, only : shr_sys_abort + use shr_log_mod, only : s_loglev => shr_log_Level + use shr_kind_mod, only : r8 => shr_kind_r8, CS => SHR_KIND_CS, CX => SHR_KIND_CX + use shr_const_mod, only : SHR_CONST_G, SHR_CONST_RDAIR, & + SHR_CONST_CPDAIR, SHR_CONST_MWWV + + implicit none + save + + private + + ! !PUBLIC MEMBER FUNCTIONS + + public :: seq_drydep_readnl ! Read namelist + public :: seq_drydep_init ! Initialization of drydep data + public :: seq_drydep_setHCoeff ! Calculate Henry's law coefficients + + ! !PRIVATE ARRAY SIZES + + integer, private, parameter :: maxspc = 100 ! Maximum number of species + integer, public, parameter :: n_species_table = 77 ! Number of species to work with + integer, private, parameter :: NSeas = 5 ! Number of seasons + integer, private, parameter :: NLUse = 11 ! Number of land-use types + + ! !PUBLIC DATA MEMBERS: + + ! method specification + character(16),public,parameter :: DD_XATM = 'xactive_atm'! dry-dep atmosphere + character(16),public,parameter :: DD_XLND = 'xactive_lnd'! dry-dep land + character(16),public,parameter :: DD_TABL = 'table' ! dry-dep table (atm and lnd) + character(16),public :: drydep_method = DD_XLND ! Which option choosen + + real(r8), public, parameter :: ph = 1.e-5_r8 ! measure of the acidity (dimensionless) + + logical, public :: lnd_drydep ! If dry-dep fields passed + integer, public :: n_drydep = 0 ! Number in drypdep list + character(len=CS), public, dimension(maxspc) :: drydep_list = '' ! List of dry-dep species + + character(len=CS), public :: drydep_fields_token = '' ! First drydep fields token + + real(r8), public, allocatable, dimension(:) :: foxd ! reactivity factor for oxidation (dimensioness) + real(r8), public, allocatable, dimension(:) :: drat ! ratio of molecular diffusivity (D_H2O/D_species; dimensionless) + integer, public, allocatable, dimension(:) :: mapping ! mapping to species table + ! --- Indices for each species --- + integer, public :: h2_ndx, ch4_ndx, co_ndx, pan_ndx, mpan_ndx, so2_ndx, o3_ndx, o3a_ndx, xpan_ndx + + !--------------------------------------------------------------------------- + ! Table 1 from Wesely, Atmos. Environment, 1989, p1293 + ! Table 2 from Sheih, microfiche PB86-218104 and Walcek, Atmos. Environment, 1986, p949 + ! Table 3-5 compiled by P. Hess + ! + ! index #1 : season + ! 1 -> midsummer with lush vegetation + ! 2 -> autumn with unharvested cropland + ! 3 -> late autumn after frost, no snow + ! 4 -> winter, snow on ground, and subfreezing + ! 5 -> transitional spring with partially green short annuals + ! + ! index #2 : landuse type + ! 1 -> urban land + ! 2 -> agricultural land + ! 3 -> range land + ! 4 -> deciduous forest + ! 5 -> coniferous forest + ! 6 -> mixed forest including wetland + ! 7 -> water, both salt and fresh + ! 8 -> barren land, mostly desert + ! 9 -> nonforested wetland + ! 10 -> mixed agricultural and range land + ! 11 -> rocky open areas with low growing shrubs + ! + ! JFL August 2000 + !--------------------------------------------------------------------------- + + !--------------------------------------------------------------------------- + ! table to parameterize the impact of soil moisture on the deposition of H2 and + ! CO on soils (from Sanderson et al., J. Atmos. Chem., 46, 15-28, 2003). + !--------------------------------------------------------------------------- + + !--- deposition of h2 and CO on soils --- + real(r8), parameter, public :: h2_a(NLUse) = & + (/ 0.000_r8, 0.000_r8, 0.270_r8, 0.000_r8, 0.000_r8, & + 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8/) + !--- deposition of h2 and CO on soils --- + real(r8), parameter, public :: h2_b(NLUse) = & + (/ 0.000_r8,-41.390_r8, -0.472_r8,-41.900_r8,-41.900_r8, & + -41.900_r8, 0.000_r8, 0.000_r8, 0.000_r8,-41.390_r8, 0.000_r8/) + !--- deposition of h2 and CO on soils --- + real(r8), parameter, public :: h2_c(NLUse) = & + (/ 0.000_r8, 16.850_r8, 1.235_r8, 19.700_r8, 19.700_r8, & + 19.700_r8, 0.000_r8, 0.000_r8, 0.000_r8, 17.700_r8, 1.000_r8/) + + !--- deposition of h2 and CO on soils + ! + !--- ri: Richardson number (dimensionless) + !--- rlu: Resistance of leaves in upper canopy (s.m-1) + !--- rac: Aerodynamic resistance to lower canopy (s.m-1) + !--- rgss: Ground surface resistance for SO2 (s.m-1) + !--- rgso: Ground surface resistance for O3 (s.m-1) + !--- rcls: Lower canopy resistance for SO2 (s.m-1) + !--- rclo: Lower canopy resistance for O3 (s.m-1) + ! + real(r8), public, dimension(NSeas,NLUse) :: ri, rlu, rac, rgss, rgso, rcls, rclo + + data ri (1,1:NLUse) & + /1.e36_r8, 60._r8, 120._r8, 70._r8, 130._r8, 100._r8,1.e36_r8,1.e36_r8, 80._r8, 100._r8, 150._r8/ + data rlu (1,1:NLUse) & + /1.e36_r8,2000._r8,2000._r8,2000._r8,2000._r8,2000._r8,1.e36_r8,1.e36_r8,2500._r8,2000._r8,4000._r8/ + data rac (1,1:NLUse) & + / 100._r8, 200._r8, 100._r8,2000._r8,2000._r8,2000._r8, 0._r8, 0._r8, 300._r8, 150._r8, 200._r8/ + data rgss(1,1:NLUse) & + / 400._r8, 150._r8, 350._r8, 500._r8, 500._r8, 100._r8, 0._r8,1000._r8, 0._r8, 220._r8, 400._r8/ + data rgso(1,1:NLUse) & + / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ + data rcls(1,1:NLUse) & + /1.e36_r8,2000._r8,2000._r8,2000._r8,2000._r8,2000._r8,1.e36_r8,1.e36_r8,2500._r8,2000._r8,4000._r8/ + data rclo(1,1:NLUse) & + /1.e36_r8,1000._r8,1000._r8,1000._r8,1000._r8,1000._r8,1.e36_r8,1.e36_r8,1000._r8,1000._r8,1000._r8/ + + data ri (2,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 250._r8, 500._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ + data rlu (2,1:NLUse) & + /1.e36_r8,9000._r8,9000._r8,9000._r8,4000._r8,8000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rac (2,1:NLUse) & + / 100._r8, 150._r8, 100._r8,1500._r8,2000._r8,1700._r8, 0._r8, 0._r8, 200._r8, 120._r8, 140._r8/ + data rgss(2,1:NLUse) & + / 400._r8, 200._r8, 350._r8, 500._r8, 500._r8, 100._r8, 0._r8,1000._r8, 0._r8, 300._r8, 400._r8/ + data rgso(2,1:NLUse) & + / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8, 800._r8, 180._r8, 200._r8/ + data rcls(2,1:NLUse) & + /1.e36_r8,9000._r8,9000._r8,9000._r8,2000._r8,4000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rclo(2,1:NLUse) & + /1.e36_r8, 400._r8, 400._r8, 400._r8,1000._r8, 600._r8,1.e36_r8,1.e36_r8, 400._r8, 400._r8, 400._r8/ + + data ri (3,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 250._r8, 500._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ + data rlu (3,1:NLUse) & + /1.e36_r8,1.e36_r8,9000._r8,9000._r8,4000._r8,8000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rac (3,1:NLUse) & + / 100._r8, 10._r8, 100._r8,1000._r8,2000._r8,1500._r8, 0._r8, 0._r8, 100._r8, 50._r8, 120._r8/ + data rgss(3,1:NLUse) & + / 400._r8, 150._r8, 350._r8, 500._r8, 500._r8, 200._r8, 0._r8,1000._r8, 0._r8, 200._r8, 400._r8/ + data rgso(3,1:NLUse) & + / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ + data rcls(3,1:NLUse) & + /1.e36_r8,1.e36_r8,9000._r8,9000._r8,3000._r8,6000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rclo(3,1:NLUse) & + /1.e36_r8,1000._r8, 400._r8, 400._r8,1000._r8, 600._r8,1.e36_r8,1.e36_r8, 800._r8, 600._r8, 600._r8/ + + data ri (4,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 400._r8, 800._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ + data rlu (4,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,6000._r8,9000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rac (4,1:NLUse) & + / 100._r8, 10._r8, 10._r8,1000._r8,2000._r8,1500._r8, 0._r8, 0._r8, 50._r8, 10._r8, 50._r8/ + data rgss(4,1:NLUse) & + / 100._r8, 100._r8, 100._r8, 100._r8, 100._r8, 100._r8, 0._r8,1000._r8, 100._r8, 100._r8, 50._r8/ + data rgso(4,1:NLUse) & + / 600._r8,3500._r8,3500._r8,3500._r8,3500._r8,3500._r8,2000._r8, 400._r8,3500._r8,3500._r8,3500._r8/ + data rcls(4,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,9000._r8, 200._r8, 400._r8,1.e36_r8,1.e36_r8,9000._r8,1.e36_r8,9000._r8/ + data rclo(4,1:NLUse) & + /1.e36_r8,1000._r8,1000._r8, 400._r8,1500._r8, 600._r8,1.e36_r8,1.e36_r8, 800._r8,1000._r8, 800._r8/ + + data ri (5,1:NLUse) & + /1.e36_r8, 120._r8, 240._r8, 140._r8, 250._r8, 190._r8,1.e36_r8,1.e36_r8, 160._r8, 200._r8, 300._r8/ + data rlu (5,1:NLUse) & + /1.e36_r8,4000._r8,4000._r8,4000._r8,2000._r8,3000._r8,1.e36_r8,1.e36_r8,4000._r8,4000._r8,8000._r8/ + data rac (5,1:NLUse) & + / 100._r8, 50._r8, 80._r8,1200._r8,2000._r8,1500._r8, 0._r8, 0._r8, 200._r8, 60._r8, 120._r8/ + data rgss(5,1:NLUse) & + / 500._r8, 150._r8, 350._r8, 500._r8, 500._r8, 200._r8, 0._r8,1000._r8, 0._r8, 250._r8, 400._r8/ + data rgso(5,1:NLUse) & + / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ + data rcls(5,1:NLUse) & + /1.e36_r8,4000._r8,4000._r8,4000._r8,2000._r8,3000._r8,1.e36_r8,1.e36_r8,4000._r8,4000._r8,8000._r8/ + data rclo(5,1:NLUse) & + /1.e36_r8,1000._r8, 500._r8, 500._r8,1500._r8, 700._r8,1.e36_r8,1.e36_r8, 600._r8, 800._r8, 800._r8/ + + !--------------------------------------------------------------------------- + ! ... roughness length + !--------------------------------------------------------------------------- + real(r8), public, dimension(NSeas,NLUse) :: z0 + + data z0 (1,1:NLUse) & + /1.000_r8,0.250_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.150_r8,0.100_r8,0.100_r8/ + data z0 (2,1:NLUse) & + /1.000_r8,0.100_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.100_r8,0.080_r8,0.080_r8/ + data z0 (3,1:NLUse) & + /1.000_r8,0.005_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.100_r8,0.020_r8,0.060_r8/ + data z0 (4,1:NLUse) & + /1.000_r8,0.001_r8,0.001_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.001_r8,0.001_r8,0.040_r8/ + data z0 (5,1:NLUse) & + /1.000_r8,0.030_r8,0.020_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.010_r8,0.030_r8,0.060_r8/ + + !real(r8), private, dimension(11,5), parameter :: z0xxx = reshape ( & + ! (/ 1.000,0.250,0.050,1.000,1.000,1.000,0.0006,0.002,0.150,0.100,0.100 , & + ! 1.000,0.100,0.050,1.000,1.000,1.000,0.0006,0.002,0.100,0.080,0.080 , & + ! 1.000,0.005,0.050,1.000,1.000,1.000,0.0006,0.002,0.100,0.020,0.060 , & + ! 1.000,0.001,0.001,1.000,1.000,1.000,0.0006,0.002,0.001,0.001,0.040 , & + ! 1.000,0.030,0.020,1.000,1.000,1.000,0.0006,0.002,0.010,0.030,0.060 /), (/11,5/) ) + + !--------------------------------------------------------------------------- + ! public chemical data + !--------------------------------------------------------------------------- + + !--- data for foxd (reactivity factor for oxidation) ---- + real(r8), public, parameter :: dfoxd(n_species_table) = & + (/ 1._r8 & + ,1._r8 & + ,1._r8 & + ,.1_r8 & + ,1.e-36_r8 & + ,1.e-36_r8 & + ,1._r8 & + ,.1_r8 & + ,1.e-36_r8 & + ,0._r8 & + ,0._r8 & + ,.1_r8 & + ,1.e-36_r8 & + ,1.e-36_r8 & + ,1.e-36_r8 & + ,.1_r8 & + ,1._r8 & + ,1.e-36_r8 & + ,.1_r8 & + ,1._r8 & + ,1.e-36_r8 & + ,.1_r8 & + ,.1_r8 & + ,.1_r8 & + ,.1_r8 & + ,1.e-36_r8 & + ,1.e-36_r8 & + ,.1_r8 & + ,1.e-36_r8 & + ,.1_r8 & + ,1.e-36_r8 & + ,.1_r8 & + ,.1_r8 & + ,1.e-36_r8 & + ,1.e-36_r8 & + ,1.e-36_r8 & + ,1.e-36_r8 & + ,.1_r8 & + ,1.e-36_r8 & + ,.1_r8 & + ,1.e-36_r8 & + ,.1_r8 & + ,.1_r8 & + ,.1_r8 & + ,1.e-36_r8 & + ,1.e-36_r8 & + ,1.e-36_r8 & + ,1.e-36_r8 & + ,1.e-36_r8 & + ,.1_r8 & + ,.1_r8 & + ,.1_r8 & + ,1.e-36_r8 & + ,1.e-36_r8 & ! HCN + ,1.e-36_r8 & ! CH3CN + ,1.e-36_r8 & ! SO2 + ,0.1_r8 & + ,0.1_r8 & + ,0.1_r8 & + ,0.1_r8 & + ,0.1_r8 & + ,0.1_r8 & + ,0.1_r8 & + ,0.1_r8 & + ,0.1_r8 & + ,0.1_r8 & + ,0.1_r8 & + ,0.1_r8 & + ,0.1_r8 & + ,0.1_r8 & + ,0.1_r8 & + ,0.1_r8 & + ,0.1_r8 & + ,0.1_r8 & + ,0.1_r8 & + ,0.1_r8 & + ,0.1_r8 & + /) + + ! PRIVATE DATA: + + Interface seq_drydep_setHCoeff ! overload subroutine + Module Procedure set_hcoeff_scalar + Module Procedure set_hcoeff_vector + End Interface + + real(r8), private, parameter :: small_value = 1.e-36_r8 !--- smallest value to use --- + + !--------------------------------------------------------------------------- + ! private chemical data + !--------------------------------------------------------------------------- + + !--- Names of species that can work with --- + character(len=20), public, parameter :: species_name_table(n_species_table) = & + (/ 'OX ' & + ,'H2O2 ' & + ,'OH ' & + ,'HO2 ' & + ,'CO ' & + ,'CH4 ' & + ,'CH3O2 ' & + ,'CH3OOH ' & + ,'CH2O ' & + ,'CHOOH ' & + ,'NO ' & + ,'NO2 ' & + ,'HNO3 ' & + ,'CO2 ' & + ,'NH3 ' & + ,'N2O5 ' & + ,'NO3 ' & + ,'CH3OH ' & + ,'HO2NO2 ' & + ,'O1D ' & + ,'C2H6 ' & + ,'C2H5O2 ' & + ,'PO2 ' & + ,'MACRO2 ' & + ,'ISOPO2 ' & + ,'C4H10 ' & + ,'CH3CHO ' & + ,'C2H5OOH ' & + ,'C3H6 ' & + ,'POOH ' & + ,'C2H4 ' & + ,'PAN ' & + ,'CH3COOOH' & + ,'C10H16 ' & + ,'CHOCHO ' & + ,'CH3COCHO' & + ,'GLYALD ' & + ,'CH3CO3 ' & + ,'C3H8 ' & + ,'C3H7O2 ' & + ,'CH3COCH3' & + ,'C3H7OOH ' & + ,'RO2 ' & + ,'ROOH ' & + ,'Rn ' & + ,'ISOP ' & + ,'MVK ' & + ,'MACR ' & + ,'C2H5OH ' & + ,'ONITR ' & + ,'ONIT ' & + ,'ISOPNO3 ' & + ,'HYDRALD ' & + ,'HCN ' & + ,'CH3CN ' & + ,'SO2 ' & + ,'SOAGff0 ' & + ,'SOAGff1 ' & + ,'SOAGff2 ' & + ,'SOAGff3 ' & + ,'SOAGff4 ' & + ,'SOAGbg0 ' & + ,'SOAGbg1 ' & + ,'SOAGbg2 ' & + ,'SOAGbg3 ' & + ,'SOAGbg4 ' & + ,'SOAG0 ' & + ,'SOAG1 ' & + ,'SOAG2 ' & + ,'SOAG3 ' & + ,'SOAG4 ' & + ,'IVOC ' & + ,'SVOC ' & + ,'IVOCbb ' & + ,'IVOCff ' & + ,'SVOCbb ' & + ,'SVOCff ' & + /) + + !--- data for effective Henry's Law coefficient --- + real(r8), public, parameter :: dheff(n_species_table*6) = & + (/1.15e-02_r8, 2560._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,8.33e+04_r8, 7379._r8,2.2e-12_r8,-3730._r8,0._r8 , 0._r8 & + ,3.00e+01_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,2.00e+03_r8, 6600._r8,3.5e-05_r8, 0._r8,0._r8 , 0._r8 & + ,1.00e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,7.47e+00_r8, 5241._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,3.11e+02_r8, 5241._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,6.30e+03_r8, 6425._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,5.53e+03_r8, 5700._r8,1.8e-04_r8,-1510._r8,0._r8 , 0._r8 & + ,1.90e-03_r8, 1480._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,6.40e-03_r8, 2500._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,0._r8 , 0._r8,2.6e+06_r8, 8700._r8,0._r8 , 0._r8 & + ,3.40e-02_r8, 2420._r8,4.5e-07_r8,-1000._r8,3.6e-11_r8,-1760._r8 & + ,7.40e+01_r8, 3400._r8,1.7e-05_r8, -450._r8,1.0e-14_r8,-6716._r8 & + ,2.14e+00_r8, 3362._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,0.65e+00_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,2.20e+02_r8, 4934._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,0._r8 , 0._r8,3.2e+01_r8, 0._r8,0._r8 , 0._r8 & + ,1.00e-16_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,7.47e+00_r8, 5241._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,7.47e+00_r8, 5241._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,7.47e+00_r8, 5241._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,7.47e+00_r8, 5241._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.14e+01_r8, 6267._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,2.20e+02_r8, 5653._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,5.00e+00_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,8.37e+02_r8, 5308._r8,1.8e-04_r8,-1510._r8,0._r8 , 0._r8 & + ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,3.00e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,3.71e+03_r8, 7541._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,4.14e+04_r8, 4630._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,7.47e+00_r8, 5241._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.45e-03_r8, 2700._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,3.00e+06_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,2.70e+01_r8, 5300._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,7.47e+00_r8, 5241._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,0.00e+00_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,2.00e+02_r8, 6500._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,7.51e+03_r8, 6485._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.00e+03_r8, 6000._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.00e+01_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,7.00e+01_r8, 6000._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.20e+01_r8, 5000._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,5.00e+01_r8, 4000._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.23e+00_r8, 3120._r8,1.23e-02_r8,1960._r8,0._r8 , 0._r8 & + ,1.3e+07_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,3.2e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,4.0e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.3e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.6e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,7.9e+11_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,6.3e+10_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,3.2e+09_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,6.3e+08_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,3.2e+07_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,4.0e+11_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,3.2e+10_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.6e+09_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,3.2e+08_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.6e+07_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & + /) + + real(r8), private, parameter :: wh2o = SHR_CONST_MWWV + real(r8), private, parameter :: mol_wgts(n_species_table) = & + (/ 47.9981995_r8, 34.0135994_r8, 17.0067997_r8, 33.0061989_r8, 28.0104008_r8, & + 16.0405998_r8, 47.0320015_r8, 48.0393982_r8, 30.0251999_r8, 46.0246010_r8, & + 30.0061398_r8, 46.0055389_r8, 63.0123405_r8, 44.0098000_r8, 17.0289402_r8, & + 108.010483_r8, 62.0049400_r8, 32.0400009_r8, 79.0117416_r8, 15.9994001_r8, & + 30.0664005_r8, 61.0578003_r8, 91.0830002_r8, 119.093399_r8, 117.119797_r8, & + 58.1180000_r8, 44.0509987_r8, 62.0652008_r8, 42.0774002_r8, 92.0904007_r8, & + 28.0515995_r8, 121.047943_r8, 76.0497971_r8, 136.228394_r8, 58.0355988_r8, & + 72.0614014_r8, 60.0503998_r8, 75.0423965_r8, 44.0922012_r8, 75.0836029_r8, & + 58.0768013_r8, 76.0910034_r8, 31.9988003_r8, 33.0061989_r8, 222.000000_r8, & + 68.1141968_r8, 70.0877991_r8, 70.0877991_r8, 46.0657997_r8, 147.125946_r8, & + 119.074341_r8, 162.117935_r8, 100.112999_r8, 27.0256_r8 , 41.0524_r8 , & + 64.064800_r8, 250._r8, 250._r8, 250._r8, 250._r8, & + 250._r8, 250._r8, 250._r8, 250._r8, 250._r8, & + 250._r8, 250._r8, 250._r8, 250._r8, 250._r8, & + 250._r8, 170.3_r8, 170.3_r8, 170.3_r8, 170.3_r8, & + 170.3_r8, 170.3_r8 /) + + +!=============================================================================== +CONTAINS +!=============================================================================== + +!==================================================================================== + + subroutine seq_drydep_readnl(NLFilename, seq_drydep_fields, seq_drydep_nflds) + + !======================================================================== + ! reads drydep_inparm namelist and sets up CCSM driver list of fields for + ! land-atmosphere communications. + ! + ! !REVISION HISTORY: + ! 2009-Feb-20 - E. Kluzek - Separate out as subroutine from previous input_init + !======================================================================== + use ESMF, only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast + use shr_file_mod,only : shr_file_getUnit, shr_file_freeUnit + use shr_log_mod, only : s_logunit => shr_log_Unit + use shr_mpi_mod, only : shr_mpi_bcast + use shr_nl_mod, only : shr_nl_find_group_name + implicit none + + character(len=*), intent(in) :: NLFilename ! Namelist filename + character(len=*), intent(out) :: seq_drydep_fields + integer, intent(out) :: seq_drydep_nflds + !----- local ----- + integer :: i ! Indices + integer :: unitn ! namelist unit number + integer :: ierr ! error code + logical :: exists ! if file exists or not + character(len=8) :: token ! dry dep field name to add + type(ESMF_VM) :: vm + integer :: localPet + integer :: tmp(1) + integer :: rc + !----- formats ----- + character(*),parameter :: subName = '(seq_drydep_read) ' + character(*),parameter :: F00 = "('(seq_drydep_read) ',8a)" + character(*),parameter :: FI1 = "('(seq_drydep_init) ',a,I2)" + + namelist /drydep_inparm/ drydep_list, drydep_method + + !----------------------------------------------------------------------------- + ! Read namelist and figure out the drydep field list to pass + ! First check if file exists and if not, n_drydep will be zero + !----------------------------------------------------------------------------- + + !--- Open and read namelist --- + if ( len_trim(NLFilename) == 0 )then + call shr_sys_abort( subName//'ERROR: nlfilename not set' ) + end if + call ESMF_VMGetCurrent(vm, rc=rc) + call ESMF_VMGet(vm, localPet=localPet, rc=rc) + seq_drydep_nflds=0 + if (localPet==0) then + inquire( file=trim(NLFileName), exist=exists) + if ( exists ) then + unitn = shr_file_getUnit() + open( unitn, file=trim(NLFilename), status='old' ) + if ( s_loglev > 0 ) write(s_logunit,F00) & + 'Read in drydep_inparm namelist from: ', trim(NLFilename) + call shr_nl_find_group_name(unitn, 'drydep_inparm', ierr) + if (ierr == 0) then + ierr = 1 + do while ( ierr /= 0 ) + read(unitn, drydep_inparm, iostat=ierr) + if (ierr < 0) then + call shr_sys_abort( subName//'ERROR: encountered end-of-file on namelist read' ) + endif + end do + else + write(s_logunit,*) 'seq_drydep_read: no drydep_inparm namelist found in ',NLFilename + endif + close( unitn ) + call shr_file_freeUnit( unitn ) + do i=1,maxspc + if(len_trim(drydep_list(i)) > 0) then + seq_drydep_nflds=seq_drydep_nflds+1 + endif + enddo + + end if + end if + tmp = seq_drydep_nflds + call ESMF_VMBroadcast(vm, tmp, 1, 0, rc=rc) + seq_drydep_nflds = tmp(1) + if(seq_drydep_nflds > 0) then + call ESMF_VMBroadcast(vm, drydep_list, CS*seq_drydep_nflds, 0, rc=rc) + call ESMF_VMBroadcast(vm, drydep_method, 16, 0, rc=rc) + endif + + !--- Loop over species to fill list of fields to communicate for drydep --- + seq_drydep_fields = ' ' + do i=1,seq_drydep_nflds + write(token,333) i + seq_drydep_fields = trim(seq_drydep_fields)//':'//trim(token) + if ( i == 1 ) then + seq_drydep_fields = trim(token) + drydep_fields_token = trim(token) + endif + enddo + + !--- Make sure method is valid and determine if land is passing drydep fields --- + lnd_drydep = seq_drydep_nflds>0 .and. drydep_method == DD_XLND + + if (localpet==0) then + if ( s_loglev > 0 ) then + write(s_logunit,*) 'seq_drydep_read: drydep_method: ', trim(drydep_method) + if ( seq_drydep_nflds == 0 )then + write(s_logunit,F00) 'No dry deposition fields will be transfered' + else + write(s_logunit,FI1) 'Number of dry deposition fields transfered is ', seq_drydep_nflds + end if + end if + end if + + if ( trim(drydep_method)/=trim(DD_XATM) .and. & + trim(drydep_method)/=trim(DD_XLND) .and. & + trim(drydep_method)/=trim(DD_TABL) ) then + if ( s_loglev > 0 ) then + write(s_logunit,*) 'seq_drydep_read: drydep_method : ', trim(drydep_method) + write(s_logunit,*) 'seq_drydep_read: drydep_method must be set to : ', & + DD_XATM,', ', DD_XLND,', or ', DD_TABL + end if + call shr_sys_abort('seq_drydep_read: incorrect dry deposition method specification') + endif + + ! Need to explicitly add Sl_ based on naming convention +333 format ('Sl_dd',i3.3) + + end subroutine seq_drydep_readnl + +!==================================================================================== + + subroutine seq_drydep_init( ) + + !======================================================================== + ! Initialization of dry deposition fields + ! reads drydep_inparm namelist and sets up CCSM driver list of fields for + ! land-atmosphere communications. + ! !REVISION HISTORY: + ! 2008-Nov-12 - F. Vitt - first version + ! 2009-Feb-20 - E. Kluzek - Check for existance of file if not return, set n_drydep=0 + ! 2009-Feb-20 - E. Kluzek - Move namelist read to separate subroutine + !======================================================================== + + use shr_log_mod, only : s_logunit => shr_log_Unit + use shr_infnan_mod, only: shr_infnan_posinf, assignment(=) + + implicit none + + !----- local ----- + integer :: i, l ! Indices + character(len=32) :: test_name ! field test name + !----- formats ----- + character(*),parameter :: subName = '(seq_drydep_init) ' + character(*),parameter :: F00 = "('(seq_drydep_init) ',8a)" + + !----------------------------------------------------------------------------- + ! Allocate and fill foxd, drat and mapping as well as species indices + !----------------------------------------------------------------------------- + + if ( n_drydep > 0 ) then + + allocate( foxd(n_drydep) ) + allocate( drat(n_drydep) ) + allocate( mapping(n_drydep) ) + + ! This initializes these variables to infinity. + foxd = shr_infnan_posinf + drat = shr_infnan_posinf + + mapping(:) = 0 + + end if + + h2_ndx=-1; ch4_ndx=-1; co_ndx=-1; mpan_ndx = -1; pan_ndx = -1; so2_ndx=-1; o3_ndx=-1; xpan_ndx=-1 + + !--- Loop over drydep species that need to be worked with --- + do i=1,n_drydep + if ( len_trim(drydep_list(i))==0 ) exit + + test_name = drydep_list(i) + + if( trim(test_name) == 'O3' ) then + test_name = 'OX' + end if + + !--- Figure out if species maps to a species in the species table --- + do l = 1,n_species_table + if( trim( test_name ) == trim( species_name_table(l) ) ) then + mapping(i) = l + exit + end if + end do + + !--- If it doesn't map to a species in the species table find species close enough --- + if( mapping(i) < 1 ) then + select case( trim(test_name) ) + case( 'H2' ) + test_name = 'CO' + case( 'HYAC', 'CH3COOH', 'EOOH', 'IEPOX' ) + test_name = 'CH2O' + case( 'O3S', 'O3INERT', 'MPAN' ) + test_name = 'OX' + case( 'ISOPOOH', 'MACROOH', 'Pb', 'XOOH', 'H2SO4' ) + test_name = 'HNO3' + case( 'ALKOOH', 'MEKOOH', 'TOLOOH', 'BENOOH', 'XYLOOH', 'SOGM','SOGI','SOGT','SOGB','SOGX' ) + test_name = 'CH3OOH' + case( 'SOA', 'SO4', 'CB1', 'CB2', 'OC1', 'OC2', 'NH3', 'NH4', 'SA1', 'SA2', 'SA3', 'SA4','HCN','CH3CN','HCOOH' ) + test_name = 'OX' ! this is just a place holder. values are explicitly set below + case( 'SOAM', 'SOAI', 'SOAT', 'SOAB', 'SOAX' ) + test_name = 'OX' ! this is just a place holder. values are explicitly set below + case( 'SOAGbb0' ) + test_name = 'SOAGff0' + case( 'SOAGbb1' ) + test_name = 'SOAGff1' + case( 'SOAGbb2' ) + test_name = 'SOAGff2' + case( 'SOAGbb3' ) + test_name = 'SOAGff3' + case( 'SOAGbb4' ) + test_name = 'SOAGff4' + case( 'NOA', 'ALKNIT', 'ISOPNITA', 'ISOPNITB', 'HONITR', 'ISOPNOOH', 'NC4CHO', 'NC4CH2OH', 'TERPNIT', 'NTERPOOH' ) + test_name = 'H2O2' + case( 'PHENOOH', 'BENZOOH', 'C6H5OOH', 'BZOOH', 'XYLOLOOH', 'XYLENOOH', 'HPALD' ) + test_name = 'CH3OOH' + case( 'TERPOOH', 'TERP2OOH', 'MBOOOH' ) + test_name = 'HNO3' + case( 'TERPROD1', 'TERPROD2' ) + test_name = 'CH2O' + case( 'HMPROP' ) + test_name = 'GLYALD' + case( 'O3A', 'XMPAN' ) + test_name = 'OX' + case( 'XPAN' ) + test_name = 'PAN' + case( 'XNO' ) + test_name = 'NO' + case( 'XNO2' ) + test_name = 'NO2' + case( 'XHNO3' ) + test_name = 'HNO3' + case( 'XONIT' ) + test_name = 'ONIT' + case( 'XONITR' ) + test_name = 'ONITR' + case( 'XHO2NO2') + test_name = 'HO2NO2' + case( 'XNH4NO3' ) + test_name = 'HNO3' + case( 'COhc','COme') + test_name = 'CO' ! this is just a place holder. values are set in drydep_fromlnd + case( 'CO01','CO02','CO03','CO04','CO05','CO06','CO07','CO08','CO09','CO10' ) + test_name = 'CO' ! this is just a place holder. values are set in drydep_fromlnd + case( 'CO11','CO12','CO13','CO14','CO15','CO16','CO17','CO18','CO19','CO20' ) + test_name = 'CO' ! this is just a place holder. values are set in drydep_fromlnd + case( 'CO21','CO22','CO23','CO24','CO25','CO26','CO27','CO28','CO29','CO30' ) + test_name = 'CO' ! this is just a place holder. values are set in drydep_fromlnd + case( 'CO31','CO32','CO33','CO34','CO35','CO36','CO37','CO38','CO39','CO40' ) + test_name = 'CO' ! this is just a place holder. values are set in drydep_fromlnd + case( 'CO41','CO42','CO43','CO44','CO45','CO46','CO47','CO48','CO49','CO50' ) + test_name = 'CO' ! this is just a place holder. values are set in drydep_fromlnd + case( 'NH4NO3' ) + test_name = 'HNO3' + case default + test_name = 'blank' + end select + + !--- If found a match check the species table again --- + if( trim(test_name) /= 'blank' ) then + do l = 1,n_species_table + if( trim( test_name ) == trim( species_name_table(l) ) ) then + mapping(i) = l + exit + end if + end do + else + if ( s_loglev > 0 ) write(s_logunit,F00) trim(drydep_list(i)), & + ' not in tables; will have dep vel = 0' + call shr_sys_abort( subName//': '//trim(drydep_list(i))//' is not in tables' ) + end if + end if + + !--- Figure out the specific species indices --- + if ( trim(drydep_list(i)) == 'H2' ) h2_ndx = i + if ( trim(drydep_list(i)) == 'CO' ) co_ndx = i + if ( trim(drydep_list(i)) == 'CH4' ) ch4_ndx = i + if ( trim(drydep_list(i)) == 'MPAN' ) mpan_ndx = i + if ( trim(drydep_list(i)) == 'PAN' ) pan_ndx = i + if ( trim(drydep_list(i)) == 'SO2' ) so2_ndx = i + if ( trim(drydep_list(i)) == 'OX' .or. trim(drydep_list(i)) == 'O3' ) o3_ndx = i + if ( trim(drydep_list(i)) == 'O3A' ) o3a_ndx = i + if ( trim(drydep_list(i)) == 'XPAN' ) xpan_ndx = i + + if( mapping(i) > 0) then + l = mapping(i) + foxd(i) = dfoxd(l) + drat(i) = sqrt(mol_wgts(l)/wh2o) + endif + + enddo + + where( rgss < 1._r8 ) + rgss = 1._r8 + endwhere + + where( rac < small_value) + rac = small_value + endwhere + + end subroutine seq_drydep_init + +!==================================================================================== + + subroutine set_hcoeff_scalar( sfc_temp, heff ) + + !======================================================================== + ! Interface to seq_drydep_setHCoeff when input is scalar + ! wrapper routine used when surface temperature is a scalar (single column) rather + ! than an array (multiple columns). + ! + ! !REVISION HISTORY: + ! 2008-Nov-12 - F. Vitt - first version + !======================================================================== + + implicit none + + real(r8), intent(in) :: sfc_temp ! Input surface temperature + real(r8), intent(out) :: heff(n_drydep) ! Output Henry's law coefficients + + !----- local ----- + real(r8) :: sfc_temp_tmp(1) ! surface temp + + sfc_temp_tmp(:) = sfc_temp + call set_hcoeff_vector( 1, sfc_temp_tmp, heff(:n_drydep) ) + + end subroutine set_hcoeff_scalar + +!==================================================================================== + + subroutine set_hcoeff_vector( ncol, sfc_temp, heff ) + + !======================================================================== + ! Interface to seq_drydep_setHCoeff when input is vector + ! sets dry depositions coefficients -- used by both land and atmosphere models + ! !REVISION HISTORY: + ! 2008-Nov-12 - F. Vitt - first version + !======================================================================== + + use shr_log_mod, only : s_logunit => shr_log_Unit + + implicit none + + integer, intent(in) :: ncol ! Input size of surface-temp vector + real(r8), intent(in) :: sfc_temp(ncol) ! Surface temperature + real(r8), intent(out) :: heff(ncol,n_drydep) ! Henry's law coefficients + + !----- local ----- + real(r8), parameter :: t0 = 298._r8 ! Standard Temperature + real(r8), parameter :: ph_inv = 1._r8/ph ! Inverse of PH + integer :: m, l, id ! indices + real(r8) :: e298 ! Henry's law coefficient @ standard temperature (298K) + real(r8) :: dhr ! temperature dependence of Henry's law coefficient + real(r8) :: dk1s(ncol) ! DK Work array 1 + real(r8) :: dk2s(ncol) ! DK Work array 2 + real(r8) :: wrk(ncol) ! Work array + + !----- formats ----- + character(*),parameter :: subName = '(seq_drydep_set_hcoeff) ' + character(*),parameter :: F00 = "('(seq_drydep_set_hcoeff) ',8a)" + + !------------------------------------------------------------------------------- + ! notes: + !------------------------------------------------------------------------------- + + wrk(:) = (t0 - sfc_temp(:))/(t0*sfc_temp(:)) + do m = 1,n_drydep + l = mapping(m) + id = 6*(l - 1) + e298 = dheff(id+1) + dhr = dheff(id+2) + heff(:,m) = e298*exp( dhr*wrk(:) ) + !--- Calculate coefficients based on the drydep tables --- + if( dheff(id+3) /= 0._r8 .and. dheff(id+5) == 0._r8 ) then + e298 = dheff(id+3) + dhr = dheff(id+4) + dk1s(:) = e298*exp( dhr*wrk(:) ) + where( heff(:,m) /= 0._r8 ) + heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph_inv) + elsewhere + heff(:,m) = dk1s(:)*ph_inv + endwhere + end if + !--- For coefficients that are non-zero AND CO2 or NH3 handle things this way --- + if( dheff(id+5) /= 0._r8 ) then + if( trim( drydep_list(m) ) == 'CO2' .or. trim( drydep_list(m) ) == 'NH3' ) then + e298 = dheff(id+3) + dhr = dheff(id+4) + dk1s(:) = e298*exp( dhr*wrk(:) ) + e298 = dheff(id+5) + dhr = dheff(id+6) + dk2s(:) = e298*exp( dhr*wrk(:) ) + !--- For Carbon dioxide --- + if( trim(drydep_list(m)) == 'CO2' ) then + heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph_inv)*(1._r8 + dk2s(:)*ph_inv) + !--- For NH3 --- + else if( trim( drydep_list(m) ) == 'NH3' ) then + heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph/dk2s(:)) + !--- This can't happen --- + else + write(s_logunit,F00) 'Bad species ',drydep_list(m) + call shr_sys_abort( subName//'ERROR: in assigning coefficients' ) + end if + end if + end if + end do + + end subroutine set_hcoeff_vector + +!=============================================================================== + +end module seq_drydep_mod diff --git a/src/shr_flds/shr_carma_mod.F90 b/src/shr_flds/shr_carma_mod.F90 new file mode 100644 index 00000000..d6d0e543 --- /dev/null +++ b/src/shr_flds/shr_carma_mod.F90 @@ -0,0 +1,82 @@ +!================================================================================ +! This reads the carma_inparm namelist in drv_flds_in and makes the relavent +! information available to CAM, CLM, and driver. The driver sets up CLM to CAM +! communication for the VOC flux fields. CLM needs to know what specific VOC +! fluxes need to be passed to the coupler and how to assimble the fluxes. +! CAM needs to know what specific VOC fluxes to expect from CLM. +! +! Mariana Vertenstein -- 24 Sep 2012 +!================================================================================ +module shr_carma_mod + + use shr_kind_mod , only : r8 => shr_kind_r8, CX => SHR_KIND_CX + use shr_sys_mod , only : shr_sys_abort + use shr_log_mod , only : loglev => shr_log_Level + use shr_log_mod , only : logunit => shr_log_Unit + use shr_nl_mod , only : shr_nl_find_group_name + use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit + + implicit none + save + private + + public :: shr_carma_readnl ! reads carma_inparm namelist + +contains + + !------------------------------------------------------------------------- + ! This reads the carma_emis_nl namelist group in drv_flds_in and parses the + ! namelist information for the driver, CLM, and CAM. + !------------------------------------------------------------------------- + subroutine shr_carma_readnl( NLFileName, carma_fields) + use ESMF, only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadcast + character(len=*) , intent(in) :: NLFileName + character(len=CX), intent(out) :: carma_fields + + type(ESMF_VM) :: vm + integer :: localPet + integer :: rc + integer :: unitn ! namelist unit number + integer :: ierr ! error code + logical :: exists ! if file exists or not + integer :: i, tmp(1) + character(*),parameter :: F00 = "('(shr_carma_readnl) ',2a)" + + namelist /carma_inparm/ carma_fields + + carma_fields = ' ' + call ESMF_VMGetCurrent(vm, rc=rc) + call ESMF_VMGet(vm, localpet=localpet, rc=rc) + tmp = 0 + if (localpet==0) then + inquire( file=trim(NLFileName), exist=exists) + if ( exists ) then + unitn = shr_file_getUnit() + open( unitn, file=trim(NLFilename), status='old' ) + if ( loglev > 0) then + write(logunit,F00) 'Read in carma_inparm namelist from: ', trim(NLFilename) + end if + call shr_nl_find_group_name(unitn, 'carma_inparm', status=ierr) + if (ierr == 0) then + read(unitn, carma_inparm, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort( 'problem on read of carma_inparm namelist in shr_carma_readnl' ) + endif + else + write(logunit,*) 'shr_carma_readnl: no carma_inparm namelist found in ',NLFilename + end if + close( unitn ) + call shr_file_freeUnit( unitn ) + else + write(logunit,*) 'shr_carma_readnl: no file ',NLFilename, ' found' + end if + if (len_trim(carma_fields) > 0) tmp(1)=1 + end if + call ESMF_VMBroadcast(vm, tmp, 1, 0, rc=rc) + if(tmp(1) == 1) then + call ESMF_VMBroadcast(vm, carma_fields, CX, 0, rc=rc) + endif + + end subroutine shr_carma_readnl + +endmodule shr_carma_mod diff --git a/src/shr_flds/shr_fire_emis_mod.F90 b/src/shr_flds/shr_fire_emis_mod.F90 new file mode 100644 index 00000000..ae4220d2 --- /dev/null +++ b/src/shr_flds/shr_fire_emis_mod.F90 @@ -0,0 +1,307 @@ +!================================================================================ +! Coordinates carbon emissions fluxes from CLM fires for use as sources of +! chemical constituents in CAM +! +! This module reads fire_emis_nl namelist which specifies the compound fluxes +! that are to be passed through the model coupler. +!================================================================================ +module shr_fire_emis_mod + + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_kind_mod , only : CL => SHR_KIND_CL, CX => SHR_KIND_CX, CS => SHR_KIND_CS + use shr_sys_mod , only : shr_sys_abort + use shr_log_mod , only : loglev => shr_log_Level + use shr_log_mod , only : logunit => shr_log_Unit + + implicit none + save + private + + public :: shr_fire_emis_readnl ! reads fire_emis_nl namelist + public :: shr_fire_emis_mechcomps ! points to an array of chemical compounds (in CAM-Chem mechanism) than have fire emissions + public :: shr_fire_emis_mechcomps_n ! number of unique compounds in the CAM chemical mechanism that have fire emissions + public :: shr_fire_emis_comps_n ! number of unique emissions components + public :: shr_fire_emis_linkedlist ! points to linked list of shr_fire_emis_comp_t objects + public :: shr_fire_emis_elevated ! elevated emissions in ATM + public :: shr_fire_emis_comp_ptr ! user defined type that points to fire emis data obj (shr_fire_emis_comp_t) + public :: shr_fire_emis_comp_t ! emission component data type + public :: shr_fire_emis_mechcomp_t ! data type for chemical compound in CAM mechanism than has fire emissions + + logical :: shr_fire_emis_elevated = .true. + + character(len=CS), public :: shr_fire_emis_fields_token = '' ! emissions fields token + character(len=CL), public :: shr_fire_emis_factors_file = '' ! a table of basic fire emissions compounds + character(len=CS), public :: shr_fire_emis_ztop_token = 'Sl_fztop' ! token for emissions top of vertical distribution + integer, parameter :: name_len=16 + + ! fire emissions component data structure (or user defined type) + type shr_fire_emis_comp_t + character(len=name_len) :: name ! emissions component name (in fire emissions input table) + integer :: index + real(r8), pointer :: emis_factors(:) ! function of plant-function-type (PFT) + real(r8) :: coeff ! emissions component coeffecient + real(r8) :: molec_weight ! molecular weight of the fire emissions compound (g/mole) + type(shr_fire_emis_comp_t), pointer :: next_emiscomp ! points to next member in the linked list + endtype shr_fire_emis_comp_t + + type shr_fire_emis_comp_ptr + type(shr_fire_emis_comp_t), pointer :: ptr ! points to fire emis data obj (shr_fire_emis_comp_t) + endtype shr_fire_emis_comp_ptr + + ! chemical compound in CAM mechanism that has fire emissions + type shr_fire_emis_mechcomp_t + character(len=16) :: name ! compound name + type(shr_fire_emis_comp_ptr), pointer :: emis_comps(:) ! an array of pointers to fire emis components + integer :: n_emis_comps ! number of fire emis compounds that make up the emissions for this mechanis compound + end type shr_fire_emis_mechcomp_t + + type(shr_fire_emis_mechcomp_t), pointer :: shr_fire_emis_mechcomps(:) ! array of chemical compounds (in CAM mechanism) that have fire emissions + type(shr_fire_emis_comp_t), pointer :: shr_fire_emis_linkedlist ! points to linked list top + + integer :: shr_fire_emis_comps_n = 0 ! number of unique fire components + integer :: shr_fire_emis_mechcomps_n = 0 ! number of unique compounds in the CAM chemical mechanism that have fire emissions + +contains + + !------------------------------------------------------------------------- + ! + ! This reads the fire_emis_nl namelist group in drv_flds_in and parses the + ! namelist information for the driver, CLM, and CAM. + ! + ! Namelist variables: + ! fire_emis_specifier, fire_emis_factors_file, fire_emis_elevated + ! + ! fire_emis_specifier (array of strings) -- Each array element specifies + ! how CAM-Chem constituents are mapped to basic smoke compounds in + ! the fire emissions factors table (fire_emis_factors_file). Each + ! chemistry constituent name (left of '=' sign) is mapped to one or more + ! smoke compound (separated by + sign if more than one), which can be + ! proceeded by a multiplication factor (separated by '*'). + ! Example: + ! fire_emis_specifier = 'bc_a1 = BC','pom_a1 = 1.4*OC','SO2 = SO2' + ! + ! fire_emis_factors_file (string) -- Input file that contains the table + ! of basic compounds that make up the smoke from the CLM fires. This is + ! used in CLM module FireEmisFactorsMod. + ! + ! fire_emis_elevated (locical) -- If true then CAM-Chem treats the fire + ! emission sources as 3-D vertically distributed forcings for the + ! corresponding chemical tracers. + ! + !------------------------------------------------------------------------- + subroutine shr_fire_emis_readnl( NLFileName, emis_fields, emis_nflds ) + use ESMF, only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadcast + use shr_nl_mod, only : shr_nl_find_group_name + use shr_file_mod, only : shr_file_getUnit, shr_file_freeUnit + + + character(len=*), intent(in) :: NLFileName ! name of namelist file + character(len=*), intent(out) :: emis_fields ! emis flux fields + integer, intent(out) :: emis_nflds + + type(ESMF_VM) :: vm + integer :: localPet + integer :: rc + integer :: unitn ! namelist unit number + integer :: ierr ! error code + logical :: exists ! if file exists or not + integer, parameter :: maxspc = 100 + character(len=2*CX) :: fire_emis_specifier(maxspc) = ' ' + character(len=CL) :: fire_emis_factors_file = ' ' + logical :: fire_emis_elevated = .true. + integer :: i, tmp(1) + character(*),parameter :: F00 = "('(shr_fire_emis_readnl) ',2a)" + + namelist /fire_emis_nl/ fire_emis_specifier, fire_emis_factors_file, fire_emis_elevated + + call ESMF_VMGetCurrent(vm, rc=rc) + call ESMF_VMGet(vm, localPet=localPet, rc=rc) + emis_nflds=0 + if (localPet==0) then + inquire( file=trim(NLFileName), exist=exists) + + if ( exists ) then + unitn = shr_file_getUnit() + open( unitn, file=trim(NLFilename), status='old' ) + if ( loglev > 0 ) write(logunit,F00) 'Read in fire_emis_readnl namelist from: ', trim(NLFilename) + call shr_nl_find_group_name(unitn, 'fire_emis_nl', status=ierr) + ! If ierr /= 0, no namelist present. + if (ierr == 0) then + read(unitn, fire_emis_nl, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort( 'problem on read of fire_emis_nl namelist in shr_fire_emis_readnl' ) + endif + endif + close( unitn ) + call shr_file_freeUnit( unitn ) + do i=1,maxspc + if(len_trim(fire_emis_specifier(i))>0) then + emis_nflds=emis_nflds+1 + endif + enddo + end if + end if + tmp = emis_nflds + call ESMF_VMBroadcast( vm, tmp, 1, 0, rc=rc) + emis_nflds = tmp(1) + if (emis_nflds > 0) then + call ESMF_VMBroadcast( vm, fire_emis_specifier, 2*CX*emis_nflds, 0, rc=rc) + call ESMF_VMBroadcast( vm, fire_emis_factors_file, CL, 0, rc=rc) + tmp = 0 + if (fire_emis_elevated) tmp = 1 + call ESMF_VMBroadcast( vm, tmp, 1, 0, rc=rc) + if(tmp(1) == 1) fire_emis_elevated = .true. + endif + + shr_fire_emis_factors_file = fire_emis_factors_file + shr_fire_emis_elevated = fire_emis_elevated + + ! parse the namelist info and initialize the module data + call shr_fire_emis_init( fire_emis_specifier, emis_fields ) + + end subroutine shr_fire_emis_readnl + + !----------------------------------------------------------------------- + ! module data initializer + !------------------------------------------------------------------------ + subroutine shr_fire_emis_init( specifier, emis_fields ) + + use shr_expr_parser_mod, only : shr_exp_parse, shr_exp_item_t, shr_exp_list_destroy + + character(len=*), intent(in) :: specifier(:) + character(len=*), intent(out) :: emis_fields + + integer :: n_entries + integer :: i, j, k + + type(shr_exp_item_t), pointer :: items_list, item + character(len=12) :: token ! fire emis field name to add + + nullify(shr_fire_emis_linkedlist) + + items_list => shr_exp_parse( specifier, nitems=n_entries ) + + allocate(shr_fire_emis_mechcomps(n_entries)) + shr_fire_emis_mechcomps(:)%n_emis_comps = 0 + + emis_fields = '' + + item => items_list + i = 1 + do while(associated(item)) + + do k=1,shr_fire_emis_mechcomps_n + if ( trim(shr_fire_emis_mechcomps(k)%name) == trim(item%name) ) then + call shr_sys_abort( 'shr_fire_emis_init : multiple emissions definitions specified for : '//trim(item%name)) + endif + enddo + if (len_trim(item%name) .le. name_len) then + shr_fire_emis_mechcomps(i)%name = item%name(1:name_len) + else + call shr_sys_abort("shr_file_emis_init : name too long for data structure :"//trim(item%name)) + endif + shr_fire_emis_mechcomps(i)%n_emis_comps = item%n_terms + allocate(shr_fire_emis_mechcomps(i)%emis_comps(item%n_terms)) + + do j = 1,item%n_terms + shr_fire_emis_mechcomps(i)%emis_comps(j)%ptr => add_emis_comp( item%vars(j), item%coeffs(j) ) + enddo + shr_fire_emis_mechcomps_n = shr_fire_emis_mechcomps_n+1 + + write(token,333) shr_fire_emis_mechcomps_n + + if ( shr_fire_emis_mechcomps_n == 1 ) then + ! do not prepend ":" to the string for the first token + emis_fields = trim(token) + shr_fire_emis_fields_token = token + else + emis_fields = trim(emis_fields)//':'//trim(token) + endif + + item => item%next_item + i = i+1 + enddo + if (associated(items_list)) call shr_exp_list_destroy(items_list) + + ! Need to explicitly add Fl_ based on naming convention +333 format ('Fall_fire',i3.3) + + end subroutine shr_fire_emis_init + + !------------------------------------------------------------------------- + ! private methods... + + + !------------------------------------------------------------------------- + !------------------------------------------------------------------------- + function add_emis_comp( name, coeff ) result(emis_comp) + + character(len=*), intent(in) :: name + real(r8), intent(in) :: coeff + type(shr_fire_emis_comp_t), pointer :: emis_comp + + emis_comp => get_emis_comp_by_name(shr_fire_emis_linkedlist, name) + if(associated(emis_comp)) then + ! already in the list so return... + return + endif + + ! create new emissions component and add it to the list + allocate(emis_comp) + + ! element%index = lookup_element( name ) + ! element%emis_factors = get_factors( list_elem%index ) + + emis_comp%index = shr_fire_emis_comps_n+1 + + emis_comp%name = trim(name) + emis_comp%coeff = coeff + nullify(emis_comp%next_emiscomp) + + call add_emis_comp_to_list(emis_comp) + + end function add_emis_comp + + !------------------------------------------------------------------------- + !------------------------------------------------------------------------- + recursive function get_emis_comp_by_name(list_comp, name) result(emis_comp) + + type(shr_fire_emis_comp_t), pointer :: list_comp + character(len=*), intent(in) :: name ! variable name + type(shr_fire_emis_comp_t), pointer :: emis_comp ! returned object + + if(associated(list_comp)) then + if(list_comp%name .eq. name) then + emis_comp => list_comp + else + emis_comp => get_emis_comp_by_name(list_comp%next_emiscomp, name) + end if + else + nullify(emis_comp) + end if + + end function get_emis_comp_by_name + + !------------------------------------------------------------------------- + !------------------------------------------------------------------------- + subroutine add_emis_comp_to_list( new_emis_comp ) + + type(shr_fire_emis_comp_t), target, intent(in) :: new_emis_comp + + type(shr_fire_emis_comp_t), pointer :: list_comp + + if(associated(shr_fire_emis_linkedlist)) then + list_comp => shr_fire_emis_linkedlist + do while(associated(list_comp%next_emiscomp)) + list_comp => list_comp%next_emiscomp + end do + list_comp%next_emiscomp => new_emis_comp + else + shr_fire_emis_linkedlist => new_emis_comp + end if + + shr_fire_emis_comps_n = shr_fire_emis_comps_n + 1 + + end subroutine add_emis_comp_to_list + +endmodule shr_fire_emis_mod diff --git a/src/shr_flds/shr_megan_mod.F90 b/src/shr_flds/shr_megan_mod.F90 new file mode 100644 index 00000000..659719f0 --- /dev/null +++ b/src/shr_flds/shr_megan_mod.F90 @@ -0,0 +1,334 @@ +!================================================================================ +! Handles MEGAN VOC emissions metadata for CLM produced chemical emissions +! MEGAN = Model of Emissions of Gases and Aerosols from Nature +! +! This reads the megan_emis_nl namelist in drv_flds_in and makes the relavent +! information available to CAM, CLM, and driver. The driver sets up CLM to CAM +! communication for the VOC flux fields. CLM needs to know what specific VOC +! fluxes need to be passed to the coupler and how to assimble the fluxes. +! CAM needs to know what specific VOC fluxes to expect from CLM. +! +! Francis Vitt -- 26 Oct 2011 +!================================================================================ +module shr_megan_mod + + use shr_kind_mod,only : r8 => shr_kind_r8 + use shr_kind_mod,only : CL => SHR_KIND_CL, CX => SHR_KIND_CX, CS => SHR_KIND_CS + use shr_sys_mod, only : shr_sys_abort + use shr_log_mod, only : loglev => shr_log_Level + use shr_log_mod, only : logunit => shr_log_Unit + + implicit none + save + private + + public :: shr_megan_readnl ! reads megan_emis_nl namelist + public :: shr_megan_mechcomps ! points to an array of chemical compounds (in CAM-Chem mechanism) that have MEGAN emissions + public :: shr_megan_mechcomps_n ! number of unique compounds in the CAM chemical mechanism that have MEGAN emissions + public :: shr_megan_megcomps_n ! number of unique MEGAN compounds + public :: shr_megan_megcomp_t ! MEGAN compound data type + public :: shr_megan_mechcomp_t ! data type for chemical compound in CAM mechanism that has MEGAN emissions + public :: shr_megan_linkedlist ! points to linked list of shr_megan_comp_t objects + public :: shr_megan_mapped_emisfctrs ! switch to use mapped emission factors + public :: shr_megan_comp_ptr + + logical , public :: megan_initialized = .false. ! true => shr_megan_readnl alreay called + character(len=CS), public :: shr_megan_fields_token = '' ! First drydep fields token + character(len=CL), public :: shr_megan_factors_file = '' + character(len=CX), public :: shr_megan_fields = '' + + ! MEGAN compound data structure (or user defined type) + type shr_megan_megcomp_t + character(len=16) :: name ! MEGAN compound name (in MEGAN input table) + integer :: index + real(r8), pointer :: emis_factors(:) ! function of plant-function-type (PFT) + integer :: class_number ! MEGAN class number + real(r8) :: coeff ! emissions component coeffecient + real(r8) :: molec_weight ! molecular weight of the MEGAN compound (g/mole) + type(shr_megan_megcomp_t), pointer :: next_megcomp ! points to next member in the linked list + endtype shr_megan_megcomp_t + + type shr_megan_comp_ptr + type(shr_megan_megcomp_t), pointer :: ptr + endtype shr_megan_comp_ptr + + ! chemical compound in CAM mechanism that has MEGAN emissions + type shr_megan_mechcomp_t + character(len=16) :: name ! compound name + type(shr_megan_comp_ptr), pointer :: megan_comps(:) ! an array of pointers to megan emis compounds + integer :: n_megan_comps ! number of megan emis compounds that make up the emissions for this mechanis compound + end type shr_megan_mechcomp_t + + type(shr_megan_mechcomp_t), pointer :: shr_megan_mechcomps(:) ! array of chemical compounds (in CAM mechanism) that have MEGAN emissions + type(shr_megan_megcomp_t), pointer :: shr_megan_linkedlist ! points to linked list top + + integer :: shr_megan_megcomps_n = 0 ! number of unique megan compounds + integer :: shr_megan_mechcomps_n = 0 ! number of unique compounds in the CAM chemical mechanism that have MEGAN emissions + + ! switch to use mapped emission factors + logical :: shr_megan_mapped_emisfctrs = .false. + +contains + + !------------------------------------------------------------------------- + ! + ! This reads the megan_emis_nl namelist group in drv_flds_in and parses the + ! namelist information for the driver, CLM, and CAM. + ! + ! Namelist variables: + ! megan_specifier, megan_mapped_emisfctrs, megan_factors_file + ! + ! megan_specifier is a series of strings where each string contains one + ! CAM chemistry constituent name (left of = sign) and one or more MEGAN + ! compound (separated by + sign if more than one). Each MEGAN compound + ! can be proceeded by a multiplication factor (separated by *). The + ! specification of the MEGAN compounds to the right of the = signs tells + ! the MEGAN VOC model within CLM how to construct the VOC fluxes using + ! the factors in megan_factors_file and land surface state. + ! + ! megan_factors_file read by CLM contains valid MEGAN compound names, + ! MEGAN class groupings and scalar emission factors + ! + ! megan_mapped_emisfctrs switch is used to tell the MEGAN model to use + ! mapped emission factors read in from the CLM surface data input file + ! rather than the scalar factors from megan_factors_file + ! + ! Example: + ! &megan_emis_nl + ! megan_specifier = 'ISOP = isoprene', + ! 'C10H16 = myrcene + sabinene + limonene + carene_3 + ocimene_t_b + pinene_b + ...', + ! 'CH3OH = methanol', + ! 'C2H5OH = ethanol', + ! 'CH2O = formaldehyde', + ! 'CH3CHO = acetaldehyde', + ! ... + ! megan_factors_file = '$datapath/megan_emis_factors.nc' + ! / + !------------------------------------------------------------------------- + subroutine shr_megan_readnl( NLFileName, megan_fields, megan_nflds ) + use ESMF, only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMBroadcast, ESMF_VMGet + use shr_nl_mod, only : shr_nl_find_group_name + use shr_file_mod, only : shr_file_getUnit, shr_file_freeUnit + + character(len=*), intent(in) :: NLFileName + character(len=*), intent(out) :: megan_fields + integer, intent(out) :: megan_nflds + + type(ESMF_VM) :: vm + integer :: localPet + integer :: unitn ! namelist unit number + integer :: ierr ! error code + logical :: exists ! if file exists or not + integer, parameter :: maxspc = 100 + character(len=2*CX) :: megan_specifier(maxspc) = ' ' + logical :: megan_mapped_emisfctrs = .false. + character(len=CL) :: megan_factors_file = ' ' + integer :: rc + integer :: i, tmp(1) + character(*),parameter :: F00 = "('(shr_megan_readnl) ',2a)" + + namelist /megan_emis_nl/ megan_specifier, megan_factors_file, megan_mapped_emisfctrs + + ! If other processes have already initialized megan - then just return + ! the megan_fields that have already been set + if (megan_initialized) then + megan_fields = trim(shr_megan_fields) + megan_nflds = shr_megan_mechcomps_n + return + end if + call ESMF_VMGetCurrent(vm, rc=rc) + call ESMF_VMGet(vm, localpet=localpet, rc=rc) + megan_nflds = 0 + if (localPet==0) then + inquire( file=trim(NLFileName), exist=exists) + if ( exists ) then + unitn = shr_file_getUnit() + open( unitn, file=trim(NLFilename), status='old' ) + if ( loglev > 0 ) write(logunit,F00) & + 'Read in megan_emis_readnl namelist from: ', trim(NLFilename) + + call shr_nl_find_group_name(unitn, 'megan_emis_nl', status=ierr) + ! If ierr /= 0, no namelist present. + + if (ierr == 0) then + read(unitn, megan_emis_nl, iostat=ierr) + + if (ierr > 0) then + call shr_sys_abort( 'problem on read of megan_emis_nl namelist in shr_megan_readnl' ) + endif + endif + + close( unitn ) + call shr_file_freeUnit( unitn ) + do i=1,maxspc + if(len_trim(megan_specifier(i)) > 0) then + megan_nflds=megan_nflds+1 + endif + enddo + end if + end if + tmp = megan_nflds + call ESMF_VMBroadcast(vm, tmp, 1, 0, rc=rc) + megan_nflds = tmp(1) + if(megan_nflds > 0) then + call ESMF_VMBroadcast(vm, megan_specifier, 2*CX*megan_nflds, 0, rc=rc) + call ESMF_VMBroadcast(vm, megan_factors_file, CL, 0, rc=rc) + tmp = 0 + if(megan_mapped_emisfctrs) tmp=1 + call ESMF_VMBroadcast(vm, tmp, 1, 0, rc=rc) + if(tmp(1)==1) megan_mapped_emisfctrs=.true. + endif + + shr_megan_factors_file = megan_factors_file + shr_megan_mapped_emisfctrs = megan_mapped_emisfctrs + + ! parse the namelist info and initialize the module data + call shr_megan_init( megan_specifier, megan_fields ) + end subroutine shr_megan_readnl + + !------------------------------------------------------------------------- + ! module data initializer + !------------------------------------------------------------------------- + subroutine shr_megan_init( specifier, megan_fields ) + + use shr_expr_parser_mod, only : shr_exp_parse, shr_exp_item_t, shr_exp_list_destroy + + character(len=*), intent(in) :: specifier(:) + character(len=*), intent(out) :: megan_fields + + integer :: n_entries + integer :: i, j, k + + type(shr_exp_item_t), pointer :: items_list, item + character(len=12) :: token ! megan field name to add + + nullify(shr_megan_linkedlist) + + items_list => shr_exp_parse( specifier, nitems=n_entries ) + + allocate(shr_megan_mechcomps(n_entries)) + shr_megan_mechcomps(:)%n_megan_comps = 0 + + megan_fields = '' + + item => items_list + i = 1 + do while(associated(item)) + + do k=1,shr_megan_mechcomps_n + if ( trim(shr_megan_mechcomps(k)%name) == trim(item%name) ) then + call shr_sys_abort( 'shr_megan_init : duplicate compound names : '//trim(item%name)) + endif + enddo + if (len_trim(item%name) .le. len(shr_megan_mechcomps(i)%name)) then + shr_megan_mechcomps(i)%name = item%name(1:len(shr_megan_mechcomps(i)%name)) + else + call shr_sys_abort( 'shr_megan_init : name too long for data structure : '//trim(item%name)) + endif + shr_megan_mechcomps(i)%n_megan_comps = item%n_terms + allocate(shr_megan_mechcomps(i)%megan_comps(item%n_terms)) + + do j = 1,item%n_terms + shr_megan_mechcomps(i)%megan_comps(j)%ptr => add_megan_comp( item%vars(j), item%coeffs(j) ) + enddo + shr_megan_mechcomps_n = shr_megan_mechcomps_n+1 + + write(token,333) shr_megan_mechcomps_n + + if ( shr_megan_mechcomps_n == 1 ) then + ! do not prepend ":" to the string for the first token + megan_fields = trim(token) + shr_megan_fields_token = token + else + megan_fields = trim(megan_fields)//':'//trim(token) + endif + + item => item%next_item + i = i+1 + enddo + if (associated(items_list)) call shr_exp_list_destroy(items_list) + + megan_initialized = .true. + shr_megan_fields = trim(megan_fields) + + ! Need to explicitly add Fl_ based on naming convention +333 format ('Fall_voc',i3.3) + + end subroutine shr_megan_init + + !------------------------------------------------------------------------- + ! private methods... + + !------------------------------------------------------------------------- + !------------------------------------------------------------------------- + function add_megan_comp( name, coeff ) result(megan_comp) + + character(len=16), intent(in) :: name + real(r8), intent(in) :: coeff + type(shr_megan_megcomp_t), pointer :: megan_comp + + megan_comp => get_megan_comp_by_name(shr_megan_linkedlist, name) + if(associated(megan_comp)) then + ! already in the list so return... + return + endif + + ! create new megan compound and add it to the list + allocate(megan_comp) + + ! element%index = lookup_element( name ) + ! element%emis_factors = get_factors( list_elem%index ) + + megan_comp%index = shr_megan_megcomps_n+1 + + megan_comp%name = trim(name) + megan_comp%coeff = coeff + nullify(megan_comp%next_megcomp) + + call add_megan_comp_to_list(megan_comp) + + end function add_megan_comp + + !------------------------------------------------------------------------- + !------------------------------------------------------------------------- + recursive function get_megan_comp_by_name(list_comp, name) result(megan_comp) + + type(shr_megan_megcomp_t), pointer :: list_comp + character(len=*), intent(in) :: name ! variable name + type(shr_megan_megcomp_t), pointer :: megan_comp ! returned object + + if(associated(list_comp)) then + if(list_comp%name .eq. name) then + megan_comp => list_comp + else + megan_comp => get_megan_comp_by_name(list_comp%next_megcomp, name) + end if + else + nullify(megan_comp) + end if + + end function get_megan_comp_by_name + + !------------------------------------------------------------------------- + !------------------------------------------------------------------------- + subroutine add_megan_comp_to_list( new_megan_comp ) + + type(shr_megan_megcomp_t), target, intent(in) :: new_megan_comp + + type(shr_megan_megcomp_t), pointer :: list_comp + + if(associated(shr_megan_linkedlist)) then + list_comp => shr_megan_linkedlist + do while(associated(list_comp%next_megcomp)) + list_comp => list_comp%next_megcomp + end do + list_comp%next_megcomp => new_megan_comp + else + shr_megan_linkedlist => new_megan_comp + end if + + shr_megan_megcomps_n = shr_megan_megcomps_n + 1 + + end subroutine add_megan_comp_to_list + +endmodule shr_megan_mod diff --git a/src/shr_flds/shr_ndep_mod.F90 b/src/shr_flds/shr_ndep_mod.F90 new file mode 100644 index 00000000..c48e0235 --- /dev/null +++ b/src/shr_flds/shr_ndep_mod.F90 @@ -0,0 +1,128 @@ +module shr_ndep_mod + + !======================================================================== + ! Module for handling nitrogen depostion of tracers. + ! This module is shared by land and atmosphere models for the computations of + ! dry deposition of tracers + !======================================================================== + + !USES: + use shr_sys_mod, only : shr_sys_abort + use shr_log_mod, only : s_loglev => shr_log_Level + use shr_log_mod , only : s_logunit => shr_log_Unit + use shr_kind_mod, only : r8 => shr_kind_r8, CS => SHR_KIND_CS, CX => SHR_KIND_CX + + implicit none + private + + ! !PUBLIC MEMBER FUNCTIONS + public :: shr_ndep_readnl ! Read namelist + character(len=*), parameter :: u_FILE_u=__FILE__ +!==================================================================================== +CONTAINS +!==================================================================================== + + subroutine shr_ndep_readnl(NLFilename, ndep_fields, ndep_nflds) + + !======================================================================== + ! reads ndep_inparm namelist and sets up driver list of fields for + ! atmosphere -> land and atmosphere -> ocn communications. + !======================================================================== + + use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit + use shr_nl_mod , only : shr_nl_find_group_name + use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMBroadcast, ESMF_VMGet + use shr_nuopc_utils_mod , only : shr_nuopc_utils_chkerr + + implicit none + + character(len=*), intent(in) :: NLFilename ! Namelist filename + character(len=*), intent(out) :: ndep_fields + integer , intent(out) :: ndep_nflds + + !----- local ----- + type(ESMF_VM) :: vm + integer :: i ! Indices + integer :: unitn ! namelist unit number + integer :: ierr ! error code + integer :: tmp(1) + logical :: exists ! if file exists or not + character(len=8) :: token ! dry dep field name to add + integer :: rc + integer, parameter :: maxspc = 100 ! Maximum number of species + character(len=32) :: ndep_list(maxspc) = '' ! List of ndep species + integer :: localpet + !----- formats ----- + character(*),parameter :: subName = '(shr_ndep_read) ' + character(*),parameter :: F00 = "('(shr_ndep_read) ',8a)" + character(*),parameter :: FI1 = "('(shr_ndep_init) ',a,I2)" + + namelist /ndep_inparm/ ndep_list + + !----------------------------------------------------------------------------- + ! Read namelist and figure out the ndep field list to pass + ! First check if file exists and if not, n_ndep will be zero + !----------------------------------------------------------------------------- + + !--- Open and read namelist --- + if ( len_trim(NLFilename) == 0 ) then + call shr_sys_abort( subName//'ERROR: nlfilename not set' ) + end if + call ESMF_VMGetCurrent(vm, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localpet=localpet, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + ndep_nflds=0 + if (localpet==0) then + inquire( file=trim(NLFileName), exist=exists) + if ( exists ) then + unitn = shr_file_getUnit() + open( unitn, file=trim(NLFilename), status='old' ) + if ( s_loglev > 0 ) then + write(s_logunit,F00) 'Read in ndep_inparm namelist from: ', trim(NLFilename) + end if + call shr_nl_find_group_name(unitn, 'ndep_inparm', ierr) + if (ierr == 0) then + ierr = 1 + do while ( ierr /= 0 ) + read(unitn, ndep_inparm, iostat=ierr) + if (ierr < 0) then + call shr_sys_abort( subName//'ERROR: encountered end-of-file on namelist read' ) + endif + end do + else + write(s_logunit,*) 'shr_ndep_readnl: no ndep_inparm namelist found in ',NLFilename + endif + close( unitn ) + call shr_file_freeUnit( unitn ) + do i=1,maxspc + if (len_trim(ndep_list(i)) > 0) then + ndep_nflds = ndep_nflds+1 + endif + enddo + end if + end if + tmp = ndep_nflds + call ESMF_VMBroadcast(vm, tmp, 1, 0, rc=rc) + ndep_nflds=tmp(1) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + ndep_fields = ' ' + + if(ndep_nflds > 0) then + call ESMF_VMBroadcast(vm, ndep_list, 32*ndep_nflds, 0, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + ! Loop over species to fill list of fields to communicate for ndep + do i=1,ndep_nflds + if ( len_trim(ndep_list(i))==0 ) exit + if ( i == 1 ) then + ndep_fields = 'Faxa_' // trim(ndep_list(i)) + else + ndep_fields = trim(ndep_fields)//':'//'Faxa_' // trim(ndep_list(i)) + endif + enddo + end if + + end subroutine shr_ndep_readnl + +end module shr_ndep_mod