From 5a4c5ee90927de8f52e02520d93bdeb09e7d2599 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Fri, 17 Apr 2020 07:41:30 -0400 Subject: [PATCH 01/32] merge escomp/cmeps master (#5) * added new prealpha test that does not have threading on for now * fix Makefile, log message print * bug fixes for prealpha tests * bug fixes for B1850 * fix problems with ocnalb calculation on intialization * update fd_nems.yaml for wave field, turn off profiling and histavg variables * udpates for esmf8.1 * make esmf8.0 and esmf8.1 compatible * changes to get nuopc to run without a mediator and bug fixes * updates with additional TODO notes * changes to have nuopc cases run without a mediator * updates to fix problem in running compsets with no mediator * fixes for running without a mediator and for running IRT tests * updates for cleaner nuopc.runconfig * update pio_stride * fix spelling error * this is a bugfix * add nuopc_share_methods for caps * change N3 test to use default pelayout Co-authored-by: Mariana Vertenstein Co-authored-by: Jim Edwards --- cime_config/buildexe | 24 +- cime_config/buildnml | 122 +- cime_config/config_archive.xml | 2 +- cime_config/config_component.xml | 36 +- cime_config/namelist_definition_drv.xml | 1347 ++++++++++---------- cime_config/testdefs/testlist_prealpha.xml | 529 ++++++++ drivers/cime/ensemble_driver.F90 | 231 ++-- drivers/cime/esm.F90 | 499 ++------ drivers/cime/esm_time_mod.F90 | 404 ++++-- drivers/cime/esm_utils_mod.F90 | 55 + mediator/Makefile | 4 +- mediator/esmFlds.F90 | 65 +- mediator/esmFldsExchange_cesm_mod.F90 | 15 +- mediator/fd_nems.yaml | 2 + mediator/med.F90 | 92 +- mediator/med_merge_mod.F90 | 72 +- mediator/med_phases_history_mod.F90 | 80 +- mediator/med_phases_ocnalb_mod.F90 | 11 +- mediator/med_phases_prep_ice_mod.F90 | 4 +- mediator/med_phases_restart_mod.F90 | 117 +- nuopc_cap_share/nuopc_shr_methods.F90 | 845 ++++++++++++ 21 files changed, 2951 insertions(+), 1605 deletions(-) create mode 100644 cime_config/testdefs/testlist_prealpha.xml create mode 100644 drivers/cime/esm_utils_mod.F90 create mode 100644 nuopc_cap_share/nuopc_shr_methods.F90 diff --git a/cime_config/buildexe b/cime_config/buildexe index f79f1d451..83d211ac9 100755 --- a/cime_config/buildexe +++ b/cime_config/buildexe @@ -32,12 +32,27 @@ def _main_func(): exeroot = case.get_value("EXEROOT") gmake = case.get_value("GMAKE") gmake_j = case.get_value("GMAKE_J") - cime_model = case.get_value("MODEL") + cime_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") gmake_args = get_standard_makefile_args(case) + # Determine valid components + valid_comps = [] + for item in case.get_values("COMP_CLASSES"): + comp = case.get_value("COMP_" + item) + valid = True + if comp == 's' + item.lower(): + valid = False + if valid: + valid_comps.append(item) + + if len(valid_comps) == 2 and "dwav" not in case.get_value("COMP_WAV") and "dlnd" not in case.get_value("COMP_LND"): + skip_mediator = True + else: + skip_mediator = False + if ocn_model == 'mom' or atm_model == "ufsatm": gmake_args += "USE_FMS=TRUE" @@ -47,15 +62,18 @@ def _main_func(): stubcomp = "s{}".format(comp.lower()) if model == stubcomp: gmake_args += " {}_PRESENT=FALSE".format(comp) + if skip_mediator: + gmake_args += " MED_PRESENT=FALSE" + gmake_args += " IAC_PRESENT=FALSE" expect((num_esp is None) or (int(num_esp) == 1), "ESP component restricted to one instance") with open('Filepath', 'w') as out: + if not skip_mediator: + out.write(os.path.join(cimeroot, "src", "drivers", "nuopc", "mediator") + "\n") out.write(os.path.join(caseroot, "SourceMods", "src.drv") + "\n") - out.write(os.path.join(cimeroot, "src", "drivers", "nuopc", "mediator") + "\n") out.write(os.path.join(cimeroot, "src", "drivers", "nuopc", "drivers", "cime") + "\n") - # build model executable makefile = os.path.join(casetools, "Makefile") diff --git a/cime_config/buildnml b/cime_config/buildnml index dc525a573..7eae6d364 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -216,37 +216,48 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): # (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: + # Determine valid components + valid_comps = [] + for item in case.get_values("COMP_CLASSES"): + comp = case.get_value("COMP_" + item) + valid = True # 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) + if comp == 's' + item.lower(): + valid = False # 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) - # special case - mosart or rtm in NULL mode - if (case.get_value("COMP_ROF") == 'mosart' or case.get_value("COMP_ROF") == 'rtm'): - if (case.get_value("MOSART_MODE") == 'NULL' or case.get_value("RTM_MODE") == 'NULL'): - skip_comps.append('ROF') - - logger.info("Writing nuopc_runseq will skip components {}".format(skip_comps)) + elif comp == 'x' + item.lower(): + if item != 'ESP': #no esp xcpl component + if case.get_value(item + "_NX") == "0" and case.get_value(item + "_NY") == "0": + valid = False + # special case - mosart or rtm in NULL mode + elif (case.get_value("COMP_ROF") == 'mosart' or case.get_value("COMP_ROF") == 'rtm'): + if (case.get_value("MOSART_MODE") == 'NULL' or case.get_value("RTM_MODE") == 'NULL'): + valid = False + if valid: + valid_comps.append(item) + + # set the driver rpointer file if there is only one non-stub component then skip mediator + + if len(valid_comps) == 2 and "dwav" not in case.get_value("COMP_WAV") and "dlnd" not in case.get_value("COMP_LND"): + skip_mediator = True + valid_comps.remove("CPL") + nmlgen.set_value('mediator_present', value='.false.') + nmlgen.set_value("drv_restart_pointer", value="none") + nmlgen.set_value("component_list", value=" ".join(valid_comps)) + else: + skip_mediator = False + nmlgen.set_value("drv_restart_pointer", value="rpointer.cpl") + valid_comps_string = " ".join(valid_comps) + nmlgen.set_value("component_list", value=valid_comps_string.replace("CPL","MED")) + logger.info("Writing nuopc_runseq for components {}".format(valid_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) + nmlgen.write_nuopc_config_file(nuopc_config_file, data_list_path=data_list_path) #-------------------------------- # (4) Write nuopc.runseq #-------------------------------- - _create_runseq(case, coupling_times) + _create_runseq(case, coupling_times, valid_comps) #-------------------------------- # (5) Write drv_flds_in @@ -294,42 +305,57 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): nmlgen.write_output_file(drv_flds_in) ############################################################################### -def _create_runseq(case, coupling_times): +def _create_runseq(case, coupling_times, valid_comps): ############################################################################### caseroot = case.get_value("CASEROOT") user_file = os.path.join(caseroot, "nuopc.runseq") + rundir = case.get_value("RUNDIR") + if os.path.exists(user_file): # Determine if there is a user run sequence file in CASEROOT, use it - rundir = case.get_value("RUNDIR") 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 + if len(valid_comps) == 1: + + # Create run sequence with no mediator + outfile = open(os.path.join(caseroot, "CaseDocs", "nuopc.runseq"), "w") + dtime = coupling_times[valid_comps[0].lower() + '_cpl_dt'] + outfile.write ("runSeq:: \n") + outfile.write ("@" + str(dtime) + " \n") + outfile.write (" " + valid_comps[0] + " \n") + outfile.write ("@ \n") + outfile.write (":: \n") + outfile.close() + shutil.copy(os.path.join(caseroot, "CaseDocs", "nuopc.runseq"), rundir) + + else: - 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") + # Create a run sequence file appropriate for target compset + 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") - sys.path.append(os.path.join(_CIMEROOT, "src", "drivers", "nuopc", "cime_config", "runseq")) + sys.path.append(os.path.join(_CIMEROOT, "src", "drivers", "nuopc", "cime_config", "runseq")) - if (comp_ice == "cice" and comp_atm == 'datm' and comp_ocn == "docn"): - from runseq_D import gen_runseq - elif (comp_lnd == 'dlnd' and comp_glc == "cism"): - from runseq_TG import gen_runseq - elif (comp_atm == 'ufsatm' and comp_ocn == "mom" and comp_ice == 'cice'): - from runseq_NEMS import gen_runseq - else: - from runseq_general import gen_runseq + if (comp_ice == "cice" and comp_atm == 'datm' and comp_ocn == "docn"): + from runseq_D import gen_runseq + elif (comp_lnd == 'dlnd' and comp_glc == "cism"): + from runseq_TG import gen_runseq + elif (comp_atm == 'ufsatm' and comp_ocn == "mom" and comp_ice == 'cice'): + from runseq_NEMS import gen_runseq + else: + from runseq_general import gen_runseq - # create the run sequence - gen_runseq(case, coupling_times) + # create the run sequence + gen_runseq(case, coupling_times) ############################################################################### def compare_drv_flds_in(first, second, infile1, infile2): @@ -409,6 +435,18 @@ def _create_component_modelio_namelists(confdir, case, files): outfile.write(" {}{}{}".format("logfile = ", logfile,"\n")) outfile.write("::\n\n") + # also write out a driver log file + if model == 'cpl': + name = "DRV" + logfile = 'drv' + inst_string + ".log." + str(lid) + 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 diff --git a/cime_config/config_archive.xml b/cime_config/config_archive.xml index c87174125..ff8bbf533 100644 --- a/cime_config/config_archive.xml +++ b/cime_config/config_archive.xml @@ -4,7 +4,7 @@ hi?\d*.*\.nc$ unset - rpointer$NINST_STRING.drv + rpointer.cpl$NINST_STRING $CASE.cpl$NINST_STRING.r.$DATENAME.nc diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index b93eaecaf..372da834a 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -2095,15 +2095,15 @@ be computed based on PIO_NUMTASKS and number of compute tasks - - - - - - - - - + $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 @@ -2114,15 +2114,15 @@ env_run.xml pio rearranger choice box=1, subset=2 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 2e006204b..476b9f015 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -139,18 +139,18 @@ - - logical - expdef - DRIVER_attributes - - turns on bfb option in coupler which produce bfb results in the - coupler on different processor counts. (default: .false.) - - - $BFBFLAG - - + + + + + + + + + + + + real @@ -303,6 +303,18 @@ + + char + expdef + DRIVER_attributes + + Driver restart pointer file to initialize time info + + + rpointer.cpl + + + @@ -535,6 +547,16 @@ + + logical + nuopc + ALLCOMP_attributes + + true + + if true, mediator is present in run + + char expdef @@ -1140,29 +1162,6 @@ 0 - - char - expdef - MED_attributes - - Mediator restart pointer file. - - - rpointer.cpl - - - - - char - expdef - MED_attributes - - Full archive path to restart file for mediator - - - str_undefined - - integer @@ -1249,7 +1248,7 @@ logical history - MED_history_attributes + MED_attributes logical to write an extra initial coupler history file @@ -1258,336 +1257,336 @@ - - logical - history - MED_history_attributes + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + char + expdef + ALLCOMP_attributes - writes atm fields in coupler average history files. - default: true + name of the coupling field with scalar information - .true. + cpl_scalars - - logical - history - MED_history_attributes + + integer + expdef + ALLCOMP_attributes - writes lnd fields in coupler average history files. - default: true + total number of scalars in the scalar coupling field - .true. + 5 - - logical - history - MED_history_attributes + + integer + expdef + ALLCOMP_attributes - writes ocn fields in coupler average history files. - default: true + index of scalar containing global grid cell count in X dimension - .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 - - - 5 - - - - - integer - expdef - ALLCOMP_attributes - - index of scalar containing global grid cell count in X dimension - - - 1 + 1 @@ -1631,7 +1630,7 @@ logical mapping - FLDS_attributes + MED_attributes used for atm->ocn and atm-ice mapping of u and v; rotate u,v to 3d cartesian space, map from src->dest, then rotate back .false. @@ -1642,7 +1641,7 @@ char mapping abs - FLDS_attributes + MED_attributes atm to ocn flux mapping file for fluxes $ATM2OCN_FMAPNAME @@ -1653,7 +1652,7 @@ char mapping abs - FLDS_attributes + MED_attributes atm to ocn state mapping file for states @@ -1666,7 +1665,7 @@ char mapping abs - FLDS_attributes + MED_attributes atm to ocn state mapping file for velocity @@ -1679,7 +1678,7 @@ char mapping abs - FLDS_attributes + MED_attributes ocn to atm mapping file for fluxes @@ -1692,7 +1691,7 @@ char mapping abs - FLDS_attributes + MED_attributes ocn to atm mapping file for states @@ -1705,7 +1704,7 @@ char mapping abs - FLDS_attributes + MED_attributes atm to ice flux mapping file for fluxes @@ -1718,7 +1717,7 @@ char mapping abs - FLDS_attributes + MED_attributes atm to ice state mapping file for states @@ -1731,7 +1730,7 @@ char mapping abs - FLDS_attributes + MED_attributes atm to ice state mapping file for velocity @@ -1744,7 +1743,7 @@ char mapping abs - FLDS_attributes + MED_attributes ice to atm mapping file for fluxes @@ -1757,7 +1756,7 @@ char mapping abs - FLDS_attributes + MED_attributes ice to atm mapping file for states @@ -1770,7 +1769,7 @@ char mapping abs - FLDS_attributes + MED_attributes atm to land mapping file for fluxes @@ -1783,7 +1782,7 @@ char mapping abs - FLDS_attributes + MED_attributes atm to land mapping file for states @@ -1796,7 +1795,7 @@ char mapping abs - FLDS_attributes + MED_attributes atm to land mapping file for states @@ -1809,7 +1808,7 @@ char mapping abs - FLDS_attributes + MED_attributes land to atm mapping file for fluxes @@ -1822,7 +1821,7 @@ char mapping abs - FLDS_attributes + MED_attributes land to atm mapping file for states @@ -1835,7 +1834,7 @@ char mapping abs - FLDS_attributes + MED_attributes lnd to runoff conservative mapping file @@ -1848,7 +1847,7 @@ char mapping abs - FLDS_attributes + MED_attributes runoff to lnd conservative mapping file @@ -1861,7 +1860,7 @@ char mapping abs - FLDS_attributes + MED_attributes runoff to lnd conservative mapping file @@ -1874,7 +1873,7 @@ char mapping abs - FLDS_attributes + MED_attributes runoff to ocn area overlap conservative mapping file @@ -1887,7 +1886,7 @@ char mapping abs - FLDS_attributes + MED_attributes glc2ocn runoff mapping file for liquid runoff @@ -1900,7 +1899,7 @@ char mapping abs - FLDS_attributes + MED_attributes glc to ice runoff conservative mapping file @@ -1913,7 +1912,7 @@ char mapping abs - FLDS_attributes + MED_attributes glc2ocn runoff mapping file for ice runoff @@ -1926,7 +1925,7 @@ char mapping abs - FLDS_attributes + MED_attributes runoff to ocn nearest neighbor plus smoothing conservative mapping file @@ -1939,7 +1938,7 @@ char mapping abs - FLDS_attributes + MED_attributes runoff to ocn nearest neighbor plus smoothing conservative mapping file @@ -1952,7 +1951,7 @@ char mapping abs - FLDS_attributes + MED_attributes land to glc mapping file for fluxes @@ -1965,7 +1964,7 @@ char mapping abs - FLDS_attributes + MED_attributes land to glc mapping file for states @@ -1978,7 +1977,7 @@ char mapping abs - FLDS_attributes + MED_attributes glc to land mapping file for fluxes @@ -1991,7 +1990,7 @@ char mapping abs - FLDS_attributes + MED_attributes glc to land mapping file for states @@ -2004,7 +2003,7 @@ char mapping abs - FLDS_attributes + MED_attributes atm to wav state mapping file for states @@ -2017,7 +2016,7 @@ char mapping abs - FLDS_attributes + MED_attributes atm to wav state mapping file for states @@ -2030,7 +2029,7 @@ char mapping abs - FLDS_attributes + MED_attributes ocn to wav state mapping file for states @@ -2043,7 +2042,7 @@ char mapping abs - FLDS_attributes + MED_attributes ice to wav state mapping file for states @@ -2056,7 +2055,7 @@ char mapping abs - FLDS_attributes + MED_attributes wav to ocn state mapping file for states @@ -2311,23 +2310,23 @@ - - 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 @@ -2484,32 +2483,6 @@ - - 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 @@ -2579,58 +2552,58 @@ - - 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 @@ -2722,136 +2695,136 @@ - - 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 - - + + + + + + + + + + + @@ -3741,100 +3714,100 @@ - - 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/testdefs/testlist_prealpha.xml b/cime_config/testdefs/testlist_prealpha.xml new file mode 100644 index 000000000..9af907ac0 --- /dev/null +++ b/cime_config/testdefs/testlist_prealpha.xml @@ -0,0 +1,529 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/drivers/cime/ensemble_driver.F90 b/drivers/cime/ensemble_driver.F90 index cee4450dd..8ddbb727f 100644 --- a/drivers/cime/ensemble_driver.F90 +++ b/drivers/cime/ensemble_driver.F90 @@ -1,17 +1,16 @@ module Ensemble_driver !----------------------------------------------------------------------------- - ! Code that creates the ensemble driver layer above the esm driver. + ! Code that creates the ensemble driver layer above the esm driver instance. ! 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 shr_kind_mod , only : cl=>shr_kind_cl - use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_internalstate_mod , only : mastertask - use med_internalstate_mod , only : logunit ! initialized here + use shr_kind_mod , only : cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_log_mod , only : shrlogunit=> shr_log_unit + use shr_file_mod , only : shr_file_setLogUnit + use esm_utils_mod , only : mastertask, logunit, chkerr implicit none private @@ -19,10 +18,11 @@ module Ensemble_driver public :: SetServices private :: SetModelServices - character(*),parameter :: u_FILE_u = __FILE__ + character(*),parameter :: u_FILE_u = & + __FILE__ !================================================================================ - contains +contains !================================================================================ subroutine SetServices(ensemble_driver, rc) @@ -30,23 +30,20 @@ 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_GridComp, ESMF_GridCompSet + use ESMF , only : ESMF_Config, ESMF_ConfigCreate, ESMF_ConfigLoadFile 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 + type(ESMF_Config) :: config 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 + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) ! NUOPC_Driver registers the generic methods call NUOPC_CompDerive(ensemble_driver, driver_routine_SS, rc=rc) @@ -67,9 +64,7 @@ subroutine SetServices(ensemble_driver, rc) call ESMF_GridCompSet(ensemble_driver, config=config, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine SetServices @@ -77,21 +72,17 @@ 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 ESMF , only : ESMF_CalendarSetDefault - use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN - 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 esm_time_mod , only : esm_time_clockInit - 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 + 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 ESMF , only : ESMF_CalendarSetDefault + use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd + use NUOPC_Driver , only : NUOPC_DriverAddComp + use esm , only : ESMSetServices => SetServices, ReadAttributes + use esm_time_mod , only : esm_time_clockInit ! input/output variables type(ESMF_GridComp) :: ensemble_driver @@ -106,15 +97,12 @@ subroutine SetModelServices(ensemble_driver, rc) 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 + character(len=CS) :: read_restart_string integer :: inst integer :: number_of_members integer :: ntasks_per_member @@ -131,19 +119,15 @@ subroutine SetModelServices(ensemble_driver, rc) !------------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) call ESMF_GridCompGet(ensemble_driver, config=config, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=localPet, PetCount=PetCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - !------------------------------------------- ! Initialize clocks !------------------------------------------- + call ReadAttributes(ensemble_driver, config, "ALLCOMP_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -164,13 +148,6 @@ subroutine SetModelServices(ensemble_driver, rc) return ! bail out end if - call ReadAttributes(ensemble_driver, config, "PELAYOUT_attributes::", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompAttributeGet(ensemble_driver, name="cpl_rootpe", value=cvalue, rc=rc) - if (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 (chkerr(rc,__LINE__,u_FILE_u)) return @@ -183,40 +160,68 @@ subroutine SetModelServices(ensemble_driver, rc) return end if - call InitRestart(ensemble_driver, read_restart, rc) + if (trim(start_type) == trim(start_type_cont) .or. trim(start_type) == trim(start_type_brnch)) then + read_restart = .true. + else + read_restart = .false. + endif + write(read_restart_string,*) read_restart + + ! Add read_restart to ensemble_driver attributes + call NUOPC_CompAttributeAdd(ensemble_driver, attrList=(/'read_restart'/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(ensemble_driver, name="ninst", value=cvalue, rc=rc) + call NUOPC_CompAttributeSet(ensemble_driver, name='read_restart', value=trim(read_restart_string), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue, *) number_of_members !------------------------------------------- ! Extract the config object from the ensemble_driver !------------------------------------------- + + call ReadAttributes(ensemble_driver, config, "PELAYOUT_attributes::", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + !------------------------------------------- + ! Determine number of ensemble members and the number of tasks per member + !------------------------------------------- + + call NUOPC_CompAttributeGet(ensemble_driver, name="ninst", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) number_of_members + + call ESMF_VMGet(vm, localPet=localPet, PetCount=PetCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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,")" + 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)) + !------------------------------------------- + ! Loop over number of ensemblel members + !------------------------------------------- - call NUOPC_CompAttributeGet(ensemble_driver, name='cpl_rootpe', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue, *) rootpe_med + allocate(petList(ntasks_per_member)) do inst=1,number_of_members + ! Determine pet list for driver instance petList(1) = (inst-1) * ntasks_per_member do n=2,ntasks_per_member petList(n) = petList(n-1) + 1 enddo + + ! Add driver instance to ensemble driver write(drvrinst,'(a,i4.4)') "ESM",inst call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=gridcomptmp, rc=rc) if (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 (chkerr(rc,__LINE__,u_FILE_u)) return @@ -226,121 +231,47 @@ subroutine SetModelServices(ensemble_driver, rc) else inst_suffix = '' endif - write(cvalue,*) read_restart + + ! Set the driver instance attributes call NUOPC_CompAttributeAdd(driver, attrList=(/'read_restart'/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(driver, name='read_restart', value=trim(cvalue), rc=rc) + call NUOPC_CompAttributeSet(driver, name='read_restart', value=trim(read_restart_string), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ReadAttributes(driver, config, "MED_attributes::", rc=rc) + call ReadAttributes(driver, config, "CLOCK_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ReadAttributes(driver, config, "CLOCK_attributes::", rc=rc) + call ReadAttributes(driver, config, "DRIVER_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ReadAttributes(driver, config, "MED_modelio"//trim(inst_suffix)//"::", rc=rc) + call ReadAttributes(driver, config, "DRV_modelio"//trim(inst_suffix)//"::", rc=rc) if (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 + ! Set the driver log to the driver task 0 + if (mod(localPet, ntasks_per_member) == 0) then call NUOPC_CompAttributeGet(driver, name="diro", value=diro, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(driver, name="logfile", value=logfile, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - logunit = shr_file_getUnit() - open(logunit,file=trim(diro)//"/"//trim(logfile)) + open (newunit=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) + + ! Create a clock for each driver instance + call esm_time_clockInit(ensemble_driver, driver, logunit, mastertask, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif enddo - call esm_time_clockInit(ensemble_driver, driver, logunit, rc) - if (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 (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 + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - !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 (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 (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 (chkerr(rc,__LINE__,u_FILE_u)) return - - end subroutine InitRestart + end subroutine SetModelServices -end module ENSEMBLE_DRIVER +end module Ensemble_driver diff --git a/drivers/cime/esm.F90 b/drivers/cime/esm.F90 index f98af4038..8955be093 100644 --- a/drivers/cime/esm.F90 +++ b/drivers/cime/esm.F90 @@ -4,11 +4,14 @@ module ESM ! Code that specializes generic ESM Component code. !----------------------------------------------------------------------------- - use ESMF , only : ESMF_Clock - use shr_kind_mod , only : r8=>shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs - use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_utils_mod , only : med_memcheck - use med_internalstate_mod , only : logunit, loglevel, mastertask, med_id + use shr_kind_mod , only : r8=>shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_log_mod , only : shrlogunit=> shr_log_unit + use shr_sys_mod , only : shr_sys_abort + use shr_mpi_mod , only : shr_mpi_bcast + use shr_mem_mod , only : shr_mem_init + use shr_file_mod , only : shr_file_setLogunit + use esm_utils_mod, only : logunit, mastertask, dbug_flag, chkerr + use perf_mod , only : t_initf implicit none private @@ -19,8 +22,6 @@ module ESM private :: SetModelServices private :: SetRunSequence private :: ModifyCplLists - private :: IsRestart - private :: InitRestart private :: InitAttributes private :: CheckAttributes private :: AddAttributes @@ -103,25 +104,18 @@ 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_file_mod , only : shr_file_setLogunit, shr_file_getunit - 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_file_mod , only : shr_file_setLogunit, shr_file_getunit - use shr_log_mod , only : shrlogunit=> shr_log_unit + 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 ! input/output variables type(ESMF_GridComp) :: driver @@ -146,6 +140,7 @@ subroutine SetModelServices(driver, rc) !------------------------------------------- ! Set the io logunit to the value defined in ensemble_driver + ! TODO: - is this statement still correct? ! it may be corrected below if the med mastertask is not the driver mastertask !------------------------------------------- call shr_file_setLogunit(logunit) @@ -160,6 +155,14 @@ subroutine SetModelServices(driver, rc) call ESMF_VMGet(vm, localPet=localPet, mpiCommunicator=global_comm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=localPet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (localPet == 0) then + mastertask=.true. + else + mastertask = .false. + end if + !------------------------------------------- ! determine the generic component labels !------------------------------------------- @@ -180,9 +183,6 @@ subroutine SetModelServices(driver, rc) call ReadAttributes(driver, config, "DRIVER_attributes::", formatprint=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ReadAttributes(driver, config, "FLDS_attributes::", formatprint=.true., rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ReadAttributes(driver, config, "CLOCK_attributes::", formatprint=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -199,7 +199,7 @@ subroutine SetModelServices(driver, rc) ! Initialize other attributes (after initializing driver clock) !------------------------------------------- - call InitAttributes(driver, mastertask, rc) + call InitAttributes(driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return !------------------------------------------- @@ -209,11 +209,9 @@ subroutine SetModelServices(driver, rc) call esm_init_pelayout(driver, maxthreads, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Print out present flags to mediator log file + ! Memory test if (mastertask) then - ! Memory test call shr_mem_init(strbuf=meminitstr) - write(logunit,*) trim(meminitstr) end if @@ -221,15 +219,7 @@ subroutine SetModelServices(driver, rc) ! Timer initialization (has to be after pelayouts are determined) !------------------------------------------- - call t_initf('drv_in', LogPrint=.true., mpicom=global_comm, & - mastertask=mastertask, MaxThreads=maxthreads) - - !------------------------------------------- - ! Perform restarts if appropriate - !------------------------------------------- - - call InitRestart(driver, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + call t_initf('drv_in', LogPrint=.true., mpicom=global_comm, mastertask=mastertask, MaxThreads=maxthreads) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -239,14 +229,14 @@ end subroutine SetModelServices subroutine SetRunSequence(driver, rc) - use ESMF , only : ESMF_GridComp, ESMF_LogWrite, ESMF_SUCCESS, ESMF_LOGMSG_INFO - use ESMF , only : 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 + use ESMF , only : ESMF_GridComp, ESMF_LogWrite, ESMF_SUCCESS, ESMF_LOGMSG_INFO + use ESMF , only : 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 @@ -312,7 +302,6 @@ subroutine pretty_print_nuopc_freeformat(ffstuff, label, rc) ! local variables integer :: i integer :: linecnt - integer :: dbug_flag = 5 character(len=NUOPC_FreeFormatLen), pointer :: outstr(:) !--------------------------------------- @@ -408,103 +397,8 @@ 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 + subroutine InitAttributes(driver, rc) - ! locals - 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 :: 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 (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 - logical :: read_restart ! read the restart file, based on start_type - character(len=CL) :: cvalue ! temporary - character(len=CL) :: rest_case_name ! Short case identification - character(len=*) , parameter :: subname = "(esm.F90:InitRestart)" - !------------------------------------------- - - rc = ESMF_SUCCESS - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) - - !----------------------------------------------------- - ! Carry out restart if appropriate - !----------------------------------------------------- - - read_restart = IsRestart(driver, rc) - if (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 (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 (chkerr(rc,__LINE__,u_FILE_u)) return - - write(cvalue,*) read_restart - call NUOPC_CompAttributeSet(driver, name='read_restart', value=trim(cvalue), rc=rc) - if (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 @@ -524,7 +418,6 @@ subroutine InitAttributes(driver, mastertask, rc) ! input/output variables type(ESMF_GridComp) , intent(inout) :: driver - logical , intent(in) :: mastertask ! mediator mastertask integer , intent(out) :: rc ! return code ! local variables @@ -559,10 +452,10 @@ subroutine InitAttributes(driver, mastertask, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - call med_memcheck(subname, 0, mastertask) !---------------------------------------------------------- ! Initialize options for reproducible sums + ! TODO: this needs to be moved out of here !---------------------------------------------------------- call NUOPC_CompAttributeGet(driver, name="reprosum_use_ddpdd", value=cvalue, rc=rc) @@ -582,6 +475,7 @@ subroutine InitAttributes(driver, mastertask, rc) !---------------------------------------------------------- ! Initialize freezing point calculation for all components + ! TODO: this needs to be moved out of here !---------------------------------------------------------- call NUOPC_CompAttributeGet(driver, name="tfreeze_option", value=tfreeze_option, rc=rc) @@ -702,7 +596,6 @@ 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 @@ -713,7 +606,6 @@ subroutine CheckAttributes( driver, rc ) !----- local ----- character(len=CL) :: cvalue ! temporary character(len=CL) :: start_type ! Type of startup - character(len=CL) :: rest_case_name ! Short case identification character(len=CS) :: logFilePostFix ! postfix for output log files character(len=CL) :: outPathRoot ! root for output log files character(len=CS) :: cime_model @@ -748,15 +640,6 @@ subroutine CheckAttributes( driver, rc ) 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 (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 !=============================================================================== @@ -783,7 +666,7 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, r integer :: stat integer :: inst_index character(len=CL) :: cvalue - character(len=32), allocatable :: attrList(:) + character(len=CS) :: attribute integer :: componentCount character(len=*), parameter :: subname = "(esm.F90:AddAttributes)" logical :: lvalue = .false. @@ -802,32 +685,20 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, r if (chkerr(rc,__LINE__,u_FILE_u)) return !------ - ! Add all the other attributes in AttrList (which have already been added to driver attributes) + ! Add restart flag a to gcomp attributes !------ - allocate(attrList(1)) - attrList = (/"read_restart"/) - - call NUOPC_CompAttributeAdd(gcomp, attrList=attrList, rc=rc) + attribute = 'read_restart' + call NUOPC_CompAttributeAdd(gcomp, (/trim(attribute)/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(driver, name="mediator_read_restart", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) lvalue + if (.not. lvalue) then + call NUOPC_CompAttributeGet(driver, name=trim(attribute), value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + call NUOPC_CompAttributeSet(gcomp, name=trim(attribute), value=trim(cvalue), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(attrList) - if (trim(attrList(n)) == "read_restart") then - call NUOPC_CompAttributeGet(driver, name="mediator_read_restart", value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) lvalue - if (.not. lvalue) then - call NUOPC_CompAttributeGet(driver, name=trim(attrList(n)), value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - call NUOPC_CompAttributeSet(gcomp, name=trim(attrList(n)), value=trim(cvalue), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - call NUOPC_CompAttributeGet(driver, name=trim(attrList(n)), value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name=trim(attrList(n)), value=trim(cvalue), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - enddo - deallocate(attrList) !------ ! Add component specific attributes @@ -845,13 +716,10 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, r if (chkerr(rc,__LINE__,u_FILE_u)) return !------ - ! Add mediator specific attributes + ! Add mediator specific attributes - if component is mediator !------ if (compname == 'MED') then - call ReadAttributes(gcomp, config, "MED_history_attributes::", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ReadAttributes(gcomp, config, "FLDS_attributes::", rc=rc) + call ReadAttributes(gcomp, config, "MED_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif @@ -955,18 +823,21 @@ 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, ESMF_UtilStringLowerCase - use NUOPC , only : NUOPC_CompAttributeGet - use NUOPC_Driver , only : NUOPC_DriverAddComp - use med_constants_mod , only : dbug_flag => med_constants_dbug_flag, CS, CL - use mpi , only : MPI_COMM_NULL - use mct_mod , only : mct_world_init - use shr_pio_mod , only : shr_pio_init2 + 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, ESMF_UtilStringLowerCase + use NUOPC , only : NUOPC_CompAttributeGet + use NUOPC_Driver , only : NUOPC_DriverAddComp + use mpi , only : MPI_COMM_NULL + use mct_mod , only : mct_world_init + use shr_pio_mod , only : shr_pio_init2 + +#ifdef MED_PRESENT + use med_internalstate_mod , only : med_id use med , only : MedSetServices => SetServices +#endif #ifdef ATM_PRESENT use atm_comp_nuopc , only : ATMSetServices => SetServices #endif @@ -1016,6 +887,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) logical, allocatable :: comp_iamin(:) character(len=5) :: inst_suffix character(CL) :: cvalue + logical :: found_comp character(len=*), parameter :: subname = "(esm_pelayout.F90:esm_init_pelayout)" !--------------------------------------- @@ -1098,7 +970,8 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) if (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 + 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 @@ -1118,51 +991,72 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) comps(i+1) = i+1 + found_comp = .false. +#ifdef MED_PRESENT if (trim(compLabels(i)) == 'MED') then med_id = i + 1 call NUOPC_DriverAddComp(driver, trim(compLabels(i)), MEDSetServices, petList=petlist, comp=child, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + found_comp = .true. + end if +#endif #ifdef ATM_PRESENT - elseif(trim(compLabels(i)) .eq. 'ATM') then + if (trim(compLabels(i)) .eq. 'ATM') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ATMSetServices, petList=petlist, comp=child, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + found_comp = .true. + end if #endif #ifdef LND_PRESENT - elseif(trim(compLabels(i)) .eq. 'LND') then + if (trim(compLabels(i)) .eq. 'LND') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), LNDSetServices, PetList=petlist, comp=child, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + found_comp = .true. + end if #endif #ifdef OCN_PRESENT - elseif(trim(compLabels(i)) .eq. 'OCN') then + if (trim(compLabels(i)) .eq. 'OCN') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), OCNSetServices, PetList=petlist, comp=child, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + found_comp = .true. + end if #endif #ifdef ICE_PRESENT - elseif(trim(compLabels(i)) .eq. 'ICE') then + if (trim(compLabels(i)) .eq. 'ICE') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ICESetServices, PetList=petlist, comp=child, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + found_comp = .true. + end if #endif #ifdef GLC_PRESENT - elseif(trim(compLabels(i)) .eq. 'GLC') then + if (trim(compLabels(i)) .eq. 'GLC') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), GLCSetServices, PetList=petlist, comp=child, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + found_comp = .true. + end if #endif #ifdef ROF_PRESENT - elseif(trim(compLabels(i)) .eq. 'ROF') then + if (trim(compLabels(i)) .eq. 'ROF') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ROFSetServices, PetList=petlist, comp=child, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + found_comp = .true. + end if #endif #ifdef WAV_PRESENT - elseif(trim(compLabels(i)) .eq. 'WAV') then + if (trim(compLabels(i)) .eq. 'WAV') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), WAVSetServices, PetList=petlist, comp=child, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + found_comp = .true. + end if #endif #ifdef ESP_PRESENT - elseif(trim(compLabels(i)) .eq. 'ESP') then + if (trim(compLabels(i)) .eq. 'ESP') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ESPSetServices, PetList=petlist, comp=child, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + found_comp = .true. + end if #endif - else + if (.not. found_comp) then write(msgstr,*) 'No component ',trim(compLabels(i)),' found' call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return @@ -1183,17 +1077,9 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) ! 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 (chkerr(rc,__LINE__,u_FILE_u)) return + ! call ESMF_GridCompSetVMMaxPEs(child, maxPeCountPerPet=nthrds, rc=rc) + ! if (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 (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_MethodAdd(child, label="GetRestartFileToRead", & - userRoutine=GetRestartFileToRead, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return comp_iamin(i) = .true. else comms(i+1) = MPI_COMM_NULL @@ -1215,10 +1101,10 @@ 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 perf_mod , only : t_prf, t_finalizef + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_VM, ESMF_VMGet + use ESMF , only : ESMF_SUCCESS + use NUOPC , only : NUOPC_CompAttributeGet + use perf_mod , only : t_prf, t_finalizef ! input/output variables type(ESMF_GridComp) :: driver @@ -1234,6 +1120,10 @@ subroutine esm_finalize(driver, rc) rc = ESMF_SUCCESS + if (mastertask) then + write(logunit,*)' SUCCESSFUL TERMINATION OF CESM' + end if + call ESMF_GridCompGet(driver, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, mpiCommunicator=mpicomm, rc=rc) @@ -1256,163 +1146,4 @@ subroutine esm_finalize(driver, rc) 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 (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 (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 (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_TimeGet(nextTime, yy=year, mm=month, dd=day, s=seconds, rc=rc) - if (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 (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, localPet=localPet, rc=rc) - if (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 - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) - - is_restart = IsRestart(gcomp, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (is_restart) then - restartname = "" - - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, localPet=localPet, rc=rc) - if (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 (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 (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/drivers/cime/esm_time_mod.F90 b/drivers/cime/esm_time_mod.F90 index 8a4619165..3554394d7 100644 --- a/drivers/cime/esm_time_mod.F90 +++ b/drivers/cime/esm_time_mod.F90 @@ -16,8 +16,7 @@ module esm_time_mod use ESMF , only : operator(-), operator(*) , operator(>=) use ESMF , only : operator(<=), operator(>), operator(==) use NUOPC , only : NUOPC_CompAttributeGet - use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_time_mod , only : med_time_alarmInit + use esm_utils_mod , only : chkerr implicit none private ! default private @@ -25,6 +24,7 @@ module esm_time_mod public :: esm_time_clockInit ! initialize driver clock (assumes default calendar) private :: esm_time_timeInit + private :: esm_time_alarmInit private :: esm_time_date2ymd ! Clock and alarm options @@ -52,11 +52,12 @@ module esm_time_mod contains !=============================================================================== - subroutine esm_time_clockInit(ensemble_driver, esmdriver, logunit, rc) + subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastertask, rc) ! input/output variables - type(ESMF_GridComp) :: ensemble_driver, esmdriver + type(ESMF_GridComp) :: ensemble_driver, instance_driver integer, intent(in) :: logunit + logical, intent(in) :: mastertask integer, intent(out) :: rc ! local variables @@ -66,8 +67,6 @@ subroutine esm_time_clockInit(ensemble_driver, esmdriver, logunit, rc) 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_Alarm) :: alarm_stop ! alarm @@ -97,67 +96,56 @@ subroutine esm_time_clockInit(ensemble_driver, esmdriver, logunit, rc) integer :: dtime_drv ! time-step to use integer :: yr, mon, day, sec ! Year, month, day, secs 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) :: inst_suffix - integer :: tmp(6) ! Array for Broadcast + integer :: tmp(4) ! Array for Broadcast logical :: isPresent character(len=*), parameter :: subname = '(esm_time_clockInit): ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_GridCompGet(esmdriver, vm=vm, rc=rc) + call ESMF_GridCompGet(instance_driver, vm=vm, rc=rc) if (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 (ChkErr(rc,__LINE__,u_FILE_u)) return - - mastertask = localPet == 0 !--------------------------------------------------------------------------- ! Determine start time, reference time and current time !--------------------------------------------------------------------------- - curr_ymd = 0 - curr_tod = 0 - - call NUOPC_CompAttributeGet(esmdriver, name="start_ymd", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name="start_ymd", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) start_ymd - call NUOPC_CompAttributeGet(esmdriver, name="start_tod", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name="start_tod", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) start_tod - call NUOPC_CompAttributeGet(esmdriver, name="ref_ymd", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ref_ymd - call NUOPC_CompAttributeGet(esmdriver, name="ref_tod", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ref_tod - - call NUOPC_CompAttributeGet(esmdriver, name='read_restart', value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name='read_restart', value=cvalue, rc=rc) if (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) + + call NUOPC_CompAttributeGet(instance_driver, name='drv_restart_pointer', value=restart_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !--- read rpointer if restart_file is set to str_undefined --- - if (trim(restart_file) == 'str_undefined') then - call NUOPC_CompAttributeGet(esmdriver, name="inst_suffix", isPresent=isPresent, rc=rc) + write(6,*)'DEBUG: restart_file = ',trim(restart_file) + + if (trim(restart_file) /= 'none') then + + call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if(isPresent) then - call NUOPC_CompAttributeGet(esmdriver, name="inst_suffix", value=inst_suffix, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", value=inst_suffix, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else inst_suffix = "" endif - restart_pfile = "rpointer.cpl"//inst_suffix + + restart_pfile = trim(restart_file)//inst_suffix + write(6,*)'DEBUG: restart_pfile = ',restart_pfile + if (mastertask) then call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), & ESMF_LOGMSG_INFO) @@ -178,37 +166,39 @@ subroutine esm_time_clockInit(ensemble_driver, esmdriver, logunit, rc) close(unitn) call ESMF_LogWrite(trim(subname)//" read driver restart from file = "//trim(restart_file), & ESMF_LOGMSG_INFO) + + call esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + write(6,*)'DEBUG: curr_ymd = ',curr_ymd + write(6,*)'DEBUG: curr_tod = ',curr_tod + tmp(1) = start_ymd ; tmp(2) = start_tod + tmp(3) = curr_ymd ; tmp(4) = curr_tod endif - endif - if (mastertask) then - call esm_time_read_restart(restart_file, & - start_ymd, start_tod, ref_ymd, ref_tod, curr_ymd, curr_tod, rc) + + call ESMF_VMBroadcast(vm, tmp, 4, 0, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - 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 (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 + start_ymd = tmp(1) ; start_tod = tmp(2) + curr_ymd = tmp(3) ; curr_tod = tmp(4) + + else + + if (mastertask) then + write(logunit,*) ' NOTE: the current compset has no mediator - which provides the clock restart information' + write(logunit,*) ' In this case the restarts are handled solely by the component being used and' + write(logunit,*) ' and the driver clock will always be starting from the initial date on restart' + end if + curr_ymd = start_ymd + curr_tod = start_tod + + end if + + else + curr_ymd = start_ymd curr_tod = start_tod - endif + + end if ! end if read_restart ! Determine start time (THE FOLLOWING ASSUMES THAT THE DEFAULT CALENDAR IS SET in the driver) @@ -225,20 +215,6 @@ subroutine esm_time_clockInit(ensemble_driver, esmdriver, logunit, rc) write(logunit,*) trim(subname)//': driver start_tod: '// trim(tmpstr) endif - ! Determine reference time - call esm_time_date2ymd(ref_ymd, yr, mon, day) - call ESMF_TimeSet( RefTime, yy=yr, mm=mon, dd=day, s=ref_tod, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if(mastertask) then - write(tmpstr,'(i10)') ref_ymd - call ESMF_LogWrite(trim(subname)//': driver ref_ymd: '// trim(tmpstr), ESMF_LOGMSG_INFO) - 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) - write(logunit,*) trim(subname)//': driver ref_tod: '// trim(tmpstr) - endif - ! Determine current time call esm_time_date2ymd(curr_ymd, yr, mon, day) call ESMF_TimeSet( CurrTime, yy=yr, mm=mon, dd=day, s=curr_tod, rc=rc) @@ -253,39 +229,46 @@ subroutine esm_time_clockInit(ensemble_driver, esmdriver, logunit, rc) write(logunit,*) trim(subname)//': driver curr_tod: '// trim(tmpstr) endif + ! Set reference time - HARD-CODED TO START TIME + ref_ymd = start_ymd + ref_tod = start_tod + call esm_time_date2ymd(ref_ymd, yr, mon, day) + call ESMF_TimeSet( RefTime, yy=yr, mm=mon, dd=day, s=ref_tod, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + !--------------------------------------------------------------------------- ! Determine driver clock timestep !--------------------------------------------------------------------------- - call NUOPC_CompAttributeGet(esmdriver, name="atm_cpl_dt", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name="atm_cpl_dt", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) atm_cpl_dt - call NUOPC_CompAttributeGet(esmdriver, name="lnd_cpl_dt", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name="lnd_cpl_dt", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) lnd_cpl_dt - call NUOPC_CompAttributeGet(esmdriver, name="ice_cpl_dt", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name="ice_cpl_dt", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) ice_cpl_dt - call NUOPC_CompAttributeGet(esmdriver, name="ocn_cpl_dt", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name="ocn_cpl_dt", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) ocn_cpl_dt - call NUOPC_CompAttributeGet(esmdriver, name="glc_cpl_dt", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name="glc_cpl_dt", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) glc_cpl_dt - call NUOPC_CompAttributeGet(esmdriver, name="rof_cpl_dt", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name="rof_cpl_dt", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) rof_cpl_dt - call NUOPC_CompAttributeGet(esmdriver, name="wav_cpl_dt", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name="wav_cpl_dt", value=cvalue, rc=rc) if (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) + call NUOPC_CompAttributeGet(instance_driver, name="glc_avg_period", value=glc_avg_period, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) glc_avg_period @@ -299,7 +282,7 @@ subroutine esm_time_clockInit(ensemble_driver, esmdriver, logunit, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------------------------------------------- - ! Create the driver clock with an artificial stop time + ! Create an instance_driver clock !--------------------------------------------------------------------------- ! Create the clock @@ -316,20 +299,20 @@ subroutine esm_time_clockInit(ensemble_driver, esmdriver, logunit, rc) if (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) + ! Set the ensemble driver gridded component clock to the created clock + call ESMF_GridCompSet(instance_driver, clock=clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Set driver clock stop time - call NUOPC_CompAttributeGet(esmdriver, name="stop_option", value=stop_option, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name="stop_option", value=stop_option, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(esmdriver, name="stop_n", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name="stop_n", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_n - call NUOPC_CompAttributeGet(esmdriver, name="stop_ymd", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name="stop_ymd", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_ymd - call NUOPC_CompAttributeGet(esmdriver, name="stop_tod", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(instance_driver, name="stop_tod", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_tod if ( stop_ymd < 0) then @@ -346,7 +329,7 @@ subroutine esm_time_clockInit(ensemble_driver, esmdriver, logunit, rc) write(logunit,*) trim(subname)//': driver stop_tod: '// trim(tmpstr) endif - call med_time_alarmInit(clock, & + call esm_time_alarmInit(clock, & alarm = alarm_stop, & option = stop_option, & opt_n = stop_n, & @@ -364,12 +347,14 @@ subroutine esm_time_clockInit(ensemble_driver, esmdriver, logunit, rc) !--------------------------------------------------------------------------- ! Create the ensemble driver clock + ! TODO: this is done repeatedly - but only needs to be done the first time this is called !--------------------------------------------------------------------------- TimeStep = StopTime - ClockTime clock = ESMF_ClockCreate(TimeStep, ClockTime, StopTime=StopTime, & refTime=RefTime, name='ESMF ensemble Driver Clock', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_GridCompSet(ensemble_driver, clock=clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -377,6 +362,202 @@ end subroutine esm_time_clockInit !=============================================================================== + subroutine esm_time_alarmInit( clock, alarm, option, & + opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) + + ! 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 = '(med_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 (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! initial guess of next alarm, this will be updated below + if (present(RefTime)) then + NextAlarm = RefTime + else + NextAlarm = CurrTime + endif + + ! Get calendar from clock + call ESMF_ClockGet(clock, calendar=cal) + + ! Error checks + if (trim(option) == optdate) then + if (.not. present(opt_ymd)) then + call ESMF_LogWrite(trim(subname)//trim(option)//' requires opt_ymd', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (lymd < 0 .or. ltod < 0) then + call ESMF_LogWrite(subname//trim(option)//'opt_ymd, opt_tod invalid', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + else if (trim(option) == optNSteps .or. & + trim(option) == optNSeconds .or. & + trim(option) == optNMinutes .or. & + trim(option) == optNHours .or. & + trim(option) == optNDays .or. & + trim(option) == optNMonths .or. & + trim(option) == optNYears) then + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + end if + + ! Determine inputs for call to create alarm + selectcase (trim(option)) + + case (optNONE) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optNever) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optNSteps) + call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNSeconds) + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMinutes) + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNHours) + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNDays) + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMonths) + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optMonthly) + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + case (optNYears) + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optYearly) + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + case default + call ESMF_LogWrite(subname//'unknown option '//trim(option), ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + + end select + + ! -------------------------------------------------------------------------------- + ! --- AlarmInterval and NextAlarm should be set --- + ! -------------------------------------------------------------------------------- + + ! --- advance Next Alarm so it won't ring on first timestep for + ! --- most options above. go back one alarminterval just to be careful + + if (update_nextalarm) then + NextAlarm = NextAlarm - AlarmInterval + do while (NextAlarm <= CurrTime) + NextAlarm = NextAlarm + AlarmInterval + enddo + endif + + alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & + ringInterval=AlarmInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine esm_time_alarmInit + + !=============================================================================== + subroutine esm_time_timeInit( Time, ymd, cal, tod, desc, logunit ) ! Create the ESMF_Time object corresponding to the given input time, given in @@ -446,8 +627,7 @@ end subroutine esm_time_date2ymd !=============================================================================== - subroutine esm_time_read_restart(restart_file, & - start_ymd, start_tod, ref_ymd, ref_tod, curr_ymd, curr_tod, rc) + subroutine esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) use netcdf , only : nf90_open, nf90_nowrite, nf90_noerr use netcdf , only : nf90_inq_varid, nf90_get_var, nf90_close @@ -455,8 +635,6 @@ subroutine esm_time_read_restart(restart_file, & ! input/output variables 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) @@ -477,6 +655,7 @@ subroutine esm_time_read_restart(restart_file, & rc = ESMF_FAILURE return endif + status = nf90_inq_varid(ncid, 'start_ymd', varid) if (status /= nf90_NoErr) then call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid start_ymd', ESMF_LOGMSG_INFO) @@ -489,6 +668,7 @@ subroutine esm_time_read_restart(restart_file, & rc = ESMF_FAILURE return end if + status = nf90_inq_varid(ncid, 'start_tod', varid) if (status /= nf90_NoErr) then call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid start_tod', ESMF_LOGMSG_INFO) @@ -501,30 +681,7 @@ subroutine esm_time_read_restart(restart_file, & rc = ESMF_FAILURE return end if - status = nf90_inq_varid(ncid, 'ref_ymd', varid) - if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid ref_ymd', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - status = nf90_get_var(ncid, varid, ref_ymd) - if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var ref_ymd', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - status = nf90_inq_varid(ncid, 'ref_tod', varid) - if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid ref_tod', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - status = nf90_get_var(ncid, varid, ref_tod) - if (status /= nf90_NoErr) then - call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var ref_tod', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if + status = nf90_inq_varid(ncid, 'curr_ymd', varid) if (status /= nf90_NoErr) then call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid curr_ymd', ESMF_LOGMSG_INFO) @@ -537,6 +694,7 @@ subroutine esm_time_read_restart(restart_file, & rc = ESMF_FAILURE return end if + status = nf90_inq_varid(ncid, 'curr_tod', varid) if (status /= nf90_NoErr) then call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid curr_tod', ESMF_LOGMSG_INFO) @@ -549,6 +707,7 @@ subroutine esm_time_read_restart(restart_file, & rc = ESMF_FAILURE return end if + status = nf90_close(ncid) if (status /= nf90_NoErr) then call ESMF_LogWrite(trim(subname)//' ERROR: nf90_close', ESMF_LOGMSG_INFO) @@ -558,14 +717,13 @@ subroutine esm_time_read_restart(restart_file, & write(tmpstr,*) trim(subname)//" read start_ymd = ",start_ymd call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + write(tmpstr,*) trim(subname)//" read start_tod = ",start_tod call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - write(tmpstr,*) trim(subname)//" read ref_ymd = ",ref_ymd - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - write(tmpstr,*) trim(subname)//" read ref_tod = ",ref_tod - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + write(tmpstr,*) trim(subname)//" read curr_ymd = ",curr_ymd call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + write(tmpstr,*) trim(subname)//" read curr_tod = ",curr_tod call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) diff --git a/drivers/cime/esm_utils_mod.F90 b/drivers/cime/esm_utils_mod.F90 new file mode 100644 index 000000000..cb5dc4360 --- /dev/null +++ b/drivers/cime/esm_utils_mod.F90 @@ -0,0 +1,55 @@ +module esm_utils_mod + + implicit none + public + + logical :: mastertask + integer :: logunit + integer :: dbug_flag = 0 + + character(*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + logical function ChkErr(rc, line, file, mpierr) +#ifdef USE_MPI2 + use mpi, only : MPI_ERROR_STRING, MPI_MAX_ERROR_STRING, MPI_SUCCESS +#else + use mpi, only : MPI_SUCCESS +#endif + 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 +#ifndef USE_MPI2 + integer, parameter :: MPI_MAX_ERROR_STRING=80 +#endif + character(MPI_MAX_ERROR_STRING) :: lstring + integer :: dbrc, lrc, len, ierr + + ChkErr = .false. + lrc = rc + if (present(mpierr) .and. mpierr) then + if (rc == MPI_SUCCESS) return +#ifdef USE_MPI2 + call MPI_ERROR_STRING(rc, lstring, len, ierr) +#else + write(lstring,*) "ERROR in mct mpi-serial library rc=",rc +#endif + call ESMF_LogWrite("ERROR: "//trim(lstring), ESMF_LOGMSG_INFO, line=line, file=file, rc=dbrc) + lrc = ESMF_FAILURE + endif + + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then + ChkErr = .true. + endif + end function ChkErr + +end module esm_utils_mod diff --git a/mediator/Makefile b/mediator/Makefile index b9dcce362..97d2e8048 100644 --- a/mediator/Makefile +++ b/mediator/Makefile @@ -53,7 +53,7 @@ med_phases_prep_lnd_mod.o : med_kind_mod.o med_internalstate_mod.o med_map_mod.o med_phases_prep_ocn_mod.o : med_kind_mod.o med_internalstate_mod.o med_constants_mod.o med_map_mod.o med_merge_mod.o med_methods_mod.o esmFlds.o med_utils_mod.o med_phases_prep_rof_mod.o : med_kind_mod.o med_internalstate_mod.o med_map_mod.o med_constants_mod.o med_merge_mod.o med_methods_mod.o esmFlds.o med_utils_mod.o med_phases_prep_wav_mod.o : med_kind_mod.o med_utils_mod.o med_internalstate_mod.o med_constants_mod.o med_map_mod.o med_methods_mod.o med_merge_mod.o esmFlds.o -med_phases_profile_mod.o : med_kind_mod.o med_utils_mod.o med_constants_mod.o med_internalstate_mod.o -med_phases_restart_mod.o : med_kind_mod.o med_utils_mod.o med_constants_mod.o med_internalstate_mod.o esmFlds.o med_io_mod.o +med_phases_profile_mod.o : med_kind_mod.o med_utils_mod.o med_constants_mod.o med_internalstate_mod.o med_time_mod.o +med_phases_restart_mod.o : med_kind_mod.o med_utils_mod.o med_constants_mod.o med_internalstate_mod.o esmFlds.o med_io_mod.o med_time_mod.o : med_kind_mod.o med_utils_mod.o med_constants_mod.o med_utils_mod.o : med_kind_mod.o med_utils_mod.F90 diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index 5f755985a..f93a60a73 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -37,7 +37,7 @@ module esmflds integer , public, parameter :: mapnstod_consf = 8 ! nearest source to destination followed by conservative frac integer , public, parameter :: nmappers = 8 - character(len=*) , public, parameter :: mapnames(nmappers) = & + character(len=*) , public, parameter :: mapnames(nmappers) = & (/'bilnr ','consf ','consd ','patch ','fcopy ','nstod ','nstod_consd','nstod_consf'/) logical, public :: mapuv_with_cart3d ! rotate u,v to 3d cartesian space, map from src->dest, then rotate back @@ -102,8 +102,8 @@ module esmflds type (med_fldList_type), public :: fldListTo(ncomps) ! advertise fields to components type (med_fldList_type), public :: fldListFr(ncomps) ! advertise fields from components - type (med_fldList_type), public :: fldListMed_aoflux - type (med_fldList_type), public :: fldListMed_ocnalb + type (med_fldList_type), public :: fldListMed_aoflux + type (med_fldList_type), public :: fldListMed_ocnalb integer :: dbrc character(len=CL) :: infostr @@ -206,7 +206,7 @@ subroutine med_fldList_AddMrg(flds, fldname, & ! ---------------------------------------------- use ESMF, only : ESMF_FAILURE, ESMF_LogWrite - use ESMF, only : ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR + use ESMF, only : ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR ! input/output variables type(med_fldList_entry_type) , pointer :: flds(:) @@ -293,19 +293,18 @@ subroutine med_fldList_AddMap(flds, fldname, destcomp, maptype, mapnorm, mapfile ! intput/output variables type(med_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=*), optional , intent(in) :: mapfile + character(len=*) , intent(in) :: fldname + integer , intent(in) :: destcomp + integer , intent(in) :: maptype + character(len=*) , intent(in) :: mapnorm + character(len=*), optional , intent(in) :: mapfile ! local variables - integer :: id, n - integer :: rc - character(CX) :: lmapfile + integer :: id, n + integer :: rc + character(len=CX) :: lmapfile character(len=*),parameter :: subname='(med_fldList_AddMap)' ! ---------------------------------------------- - lmapfile = 'unset' if (present(mapfile)) lmapfile = mapfile @@ -358,7 +357,10 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num 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 - +#if ESMF_VERSION_MINOR > 0 + use ESMF , only : ESMF_STATEINTENT_IMPORT, ESMF_STATEINTENT_EXPORT, ESMF_StateIntent_Flag + use ESMF , only : ESMF_RC_ARG_BAD, ESMF_LogSetError, operator(==) +#endif ! input/output variables type(ESMF_State) , intent(inout) :: state type(med_fldlist_type), intent(in) :: fldList @@ -375,6 +377,10 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num type(ESMF_Field) :: field character(CS) :: shortname character(CS) :: stdname +#if ESMF_VERSION_MINOR > 0 + type(ESMF_StateIntent_Flag) :: stateIntent + character(ESMF_MAXSTR) :: transferActionAttr +#endif character(ESMF_MAXSTR) :: transferAction character(ESMF_MAXSTR), pointer :: StandardNameList(:) character(ESMF_MAXSTR), pointer :: ConnectedList(:) @@ -438,6 +444,21 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num #endif nflds = size(fldList%flds) +#if ESMF_VERSION_MINOR > 0 + call ESMF_StateGet(state, stateIntent=stateIntent, rc=rc) + if (stateIntent==ESMF_STATEINTENT_EXPORT) then + transferActionAttr="ProducerTransferAction" + elseif (stateIntent==ESMF_STATEINTENT_IMPORT) then + transferActionAttr="ConsumerTransferAction" + else + call ESMF_LogSetError(ESMF_RC_ARG_BAD, & + msg="The stateIntent must either be IMPORT or EXPORT here.", & + line=__LINE__, & + file=__FILE__, & + rcToReturn=rc) + return ! bail out + endif +#endif do n = 1, nflds shortname = fldList%flds(n)%shortname @@ -447,8 +468,12 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num 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 - +#if ESMF_VERSION_MINOR > 0 + call NUOPC_GetAttribute(field, name=TransferActionAttr, value=transferAction, rc=rc) +#else call NUOPC_GetAttribute(field, name="TransferActionGeomObject", value=transferAction, rc=rc) +#endif + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return if (trim(transferAction) == "accept") then ! accept @@ -657,7 +682,7 @@ subroutine med_fldList_Document_Mapping(logunit, med_coupling_active) ! input/output variables integer, intent(in) :: logunit - logical, intent(in) :: med_coupling_active(:,:) + logical, intent(in) :: med_coupling_active(:,:) ! local variables integer :: nsrc,ndst,nf,nm,n @@ -678,7 +703,7 @@ subroutine med_fldList_Document_Mapping(logunit, med_coupling_active) !----------------------------------------------------------- !--------------------------------------- - ! Document mapping (also add albedo and aoflux) + ! Document mapping (also add albedo and aoflux) !--------------------------------------- ! Loop over src components @@ -751,12 +776,12 @@ end subroutine med_fldList_Document_Mapping subroutine med_fldList_Document_Merging(logunit, med_coupling_active) !--------------------------------------- - ! Document merging to target destination fields + ! Document merging to target destination fields !--------------------------------------- ! input/output variables integer, intent(in) :: logunit - logical, intent(in) :: med_coupling_active(:,:) + logical, intent(in) :: med_coupling_active(:,:) ! local variables integer :: nsrc,ndst,nf,n @@ -796,7 +821,7 @@ subroutine med_fldList_Document_Merging(logunit, med_coupling_active) 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)//')' + 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 diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 52088c112..83ec64615 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -862,14 +862,15 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if ! 'wild fire plume height' + fldname = 'Sl_fztop' if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, 'Sl_fztop') - call addfld(fldListTo(compatm)%flds, 'Sl_fztop') + call addfld(fldListFr(complnd)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) 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', & + 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 if @@ -1942,7 +1943,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) 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) + call addmap(fldListFr(compocn)%flds, 'Faoo_fco2_ocn', compatm, mapconsf, 'one', atm2lnd_smap) ! custom merge in med_phases_prep_atm end if endif diff --git a/mediator/fd_nems.yaml b/mediator/fd_nems.yaml index 9dd2ace98..8fcf95268 100644 --- a/mediator/fd_nems.yaml +++ b/mediator/fd_nems.yaml @@ -585,3 +585,5 @@ canonical_units: W m-2 - standard_name: land_mask canonical_units: 1 + - standard_name: wave_z0_roughness_length + canonical_units: 1 diff --git a/mediator/med.F90 b/mediator/med.F90 index b38997dde..3e3637529 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -17,7 +17,7 @@ module MED use med_methods_mod , only : State_GeomWrite => med_methods_State_GeomWrite use med_methods_mod , only : State_reset => med_methods_State_reset use med_methods_mod , only : State_getNumFields => med_methods_State_getNumFields - use med_methods_mod , only : State_GetScalar => med_methods_State_GetScalar + use med_methods_mod , only : State_GetScalar => med_methods_State_GetScalar use med_methods_mod , only : FB_Init => med_methods_FB_init use med_methods_mod , only : FB_Init_pointer => med_methods_FB_Init_pointer use med_methods_mod , only : FB_Reset => med_methods_FB_Reset @@ -25,7 +25,7 @@ module MED use med_methods_mod , only : FB_FldChk => med_methods_FB_FldChk use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : clock_timeprint => med_methods_clock_timeprint - use med_time_mod , only : alarmInit => med_time_alarmInit + use med_time_mod , only : alarmInit => med_time_alarmInit use med_utils_mod , only : memcheck => med_memcheck use med_internalstate_mod , only : InternalState use med_internalstate_mod , only : med_coupling_allowed, logunit, mastertask @@ -60,7 +60,7 @@ module MED character(len=*), parameter :: grid_arbopt = "grid_reg" ! grid_reg or grid_arb character(len=*), parameter :: u_FILE_u = & __FILE__ - logical :: profile_memory = .true. + logical :: profile_memory = .false. !----------------------------------------------------------------------------- contains @@ -384,8 +384,8 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_VM, ESMF_SUCCESS use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_AttributeGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_METHOD_INITIALIZE - use NUOPC , only : NUOPC_CompFilterPhaseMap - use med_internalstate_mod, only : mastertask + use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_CompAttributeGet + use med_internalstate_mod, only : mastertask, logunit type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -393,10 +393,13 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables - type(ESMF_VM) :: vm - character(len=128) :: value - integer :: localPet - character(len=CX) :: msgString + type(ESMF_VM) :: vm + character(len=CL) :: value + integer :: localPet + logical :: isPresent, isSet + character(len=CX) :: msgString + character(len=CX) :: diro + character(len=CX) :: logfile character(len=*),parameter :: subname='(module_MED:InitializeP0)' !----------------------------------------------------------- @@ -409,6 +412,23 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) mastertask = .false. if (localPet == 0) mastertask=.true. + ! Determine mediator logunit + if (mastertask) then + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (.not. isPresent .and. .not. isSet) then + diro = './' + end if + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (.not. isPresent .and. .not. isSet) then + logfile = 'mediator.log' + end if + open(newunit=logunit, file=trim(diro)//"/"//trim(logfile)) + else + logUnit = 6 + endif + call ESMF_AttributeGet(gcomp, name="Verbosity", value=value, defaultValue="max", & convention="NUOPC", purpose="Instance", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -465,7 +485,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) character(len=8) :: ice_present, rof_present character(len=8) :: glc_present, med_present character(len=8) :: ocn_present, wav_present - character(len=32) :: attrList(8) + character(len=CS) :: attrList(8) character(len=*),parameter :: subname='(module_MED:InitializeIPDv03p1)' !----------------------------------------------------------- @@ -530,7 +550,9 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name='coupling_mode', value=coupling_mode, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite('coupling_mode = '// trim(coupling_mode), ESMF_LOGMSG_INFO) - write(logunit,*)' Mediator Coupling Mode is ',trim(coupling_mode) + if (mastertask) then + write(logunit,*)' Mediator Coupling Mode is ',trim(coupling_mode) + end if if (trim(coupling_mode) == 'cesm') then call esmFldsExchange_cesm(gcomp, phase='advertise', rc=rc) @@ -709,7 +731,10 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) 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 - +#if ESMF_VERSION_MINOR > 0 + use ESMF , only : ESMF_StateSet, ESMF_StateIntent_Import, ESMF_StateIntent_Export + use ESMF , only : ESMF_StateIntent_Flag +#endif ! Input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -740,13 +765,21 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) ! Realize States do n = 1,ncomps if (ESMF_StateIsCreated(is_local%wrap%NStateImp(n), rc=rc)) then +#if ESMF_VERSION_MINOR > 0 + call ESMF_StateSet(is_local%wrap%NStateImp(n), stateIntent=ESMF_StateIntent_Import, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return +#endif call med_fldList_Realize(is_local%wrap%NStateImp(n), fldListFr(n), & is_local%wrap%flds_scalar_name, is_local%wrap%flds_scalar_num, & tag=subname//':Fr_'//trim(compname(n)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif if (ESMF_StateIsCreated(is_local%wrap%NStateExp(n), rc=rc)) then - call med_fldList_Realize(is_local%wrap%NStateExp(n), fldListTo(n), & +#if ESMF_VERSION_MINOR > 0 + call ESMF_StateSet(is_local%wrap%NStateExp(n), stateIntent=ESMF_StateIntent_Export, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return +#endif + call med_fldList_Realize(is_local%wrap%NStateExp(n), fldListTo(n), & is_local%wrap%flds_scalar_name, is_local%wrap%flds_scalar_num, & tag=subname//':To_'//trim(compname(n)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1831,8 +1864,7 @@ subroutine DataInitialize(gcomp, rc) call med_fraction_set(gcomp,rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! should this be added here? - if (is_local%wrap%comp_present(compocn)) then + if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compatm)) then call med_phases_ocnalb_run(gcomp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -1845,8 +1877,8 @@ subroutine DataInitialize(gcomp, rc) 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 + 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 (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(fieldNameList(fieldCount)) @@ -1868,16 +1900,6 @@ subroutine DataInitialize(gcomp, rc) 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 (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_fraction_set(gcomp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Initialize ocean albedo module and compute ocean albedos - call med_phases_ocnalb_run(gcomp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! do the merge to the atmospheric component call med_phases_prep_atm(gcomp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2020,16 +2042,15 @@ subroutine SetRunClock(gcomp, rc) 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 + character(len=CL) :: cvalue + character(len=CL) :: 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) :: glc_avg_alarm logical :: glc_present - character(len=16) :: glc_avg_period - integer :: opt_n - integer :: opt_ymd + character(len=CS) :: glc_avg_period + integer :: glc_cpl_dt type(ESMF_ALARM) :: alarm logical :: first_time = .true. character(len=*),parameter :: subname='(module_MED:SetRunClock)' @@ -2087,9 +2108,14 @@ subroutine SetRunClock(gcomp, rc) else if (trim(glc_avg_period) == 'yearly') then call alarmInit(mediatorclock, glc_avg_alarm, 'nyears', opt_n=1, alarmname='alarm_glc_avg', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + else if (trim(glc_avg_period) == 'glc_coupling_period') then + call NUOPC_CompAttributeGet(gcomp, name="glc_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) glc_cpl_dt + call alarmInit(mediatorclock, glc_avg_alarm, 'nseconds', opt_n=glc_cpl_dt, alarmname='alarm_glc_avg', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)//& - ": ERROR glc_avg_period = "//trim(glc_avg_period)//" not supported", & + call ESMF_LogWrite(trim(subname)// ": ERROR glc_avg_period = "//trim(glc_avg_period)//" not supported", & ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_FAILURE RETURN diff --git a/mediator/med_merge_mod.F90 b/mediator/med_merge_mod.F90 index d3d3b7a0f..3fa8daf17 100644 --- a/mediator/med_merge_mod.F90 +++ b/mediator/med_merge_mod.F90 @@ -35,7 +35,6 @@ module med_merge_mod private :: med_merge_auto_field - character(len=CL) :: errmsg character(*),parameter :: u_FILE_u = & __FILE__ @@ -45,9 +44,10 @@ module med_merge_mod subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, FBMed2, 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_FieldBundle, ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet + use ESMF , only : ESMF_Field, ESMF_FieldGet + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR use ESMF , only : ESMF_LogSetError, ESMF_RC_OBJ_NOT_CREATED ! ---------------------------------------------- @@ -59,7 +59,7 @@ subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, 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(med_fldList_type) , intent(in) :: fldListTo ! Information for merging + type(med_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 integer , intent(out) :: rc @@ -72,12 +72,11 @@ subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, 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) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS call FB_reset(FBOut, value=czero, rc=rc) @@ -148,7 +147,7 @@ subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, else call ESMF_LogWrite(trim(subname)//": ERROR merge_field = "//trim(merge_field)//" not found", & - ESMF_LOGMSG_INFO, rc=rc) + ESMF_LOGMSG_ERROR, rc=rc) rc = ESMF_FAILURE if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -167,7 +166,7 @@ subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, else call ESMF_LogWrite(trim(subname)//": ERROR merge_field = "//trim(merge_field)//"not found", & - ESMF_LOGMSG_INFO, rc=rc) + ESMF_LOGMSG_ERROR, rc=rc) rc = ESMF_FAILURE if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -194,7 +193,7 @@ subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, !--- clean up !--------------------------------------- - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) call t_stopf('MED:'//subname) end subroutine med_merge_auto @@ -224,11 +223,14 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld real(R8), pointer :: dp1 (:), dp2(:,:) ! output pointers to 1d and 2d fields real(R8), pointer :: dpf1(:), dpf2(:,:) ! intput pointers to 1d and 2d fields real(R8), pointer :: dpw1(:) ! weight pointer - integer :: lrank ! rank of array + integer :: lrank_input ! rank of input array + integer :: lrank_output ! rank of output array integer :: ungriddedUBound_output(1) ! currently the size must equal 1 for rank 2 fieldds integer :: ungriddedUBound_input(1) ! currently the size must equal 1 for rank 2 fieldds integer :: gridToFieldMap_output(1) ! currently the size must equal 1 for rank 2 fieldds integer :: gridToFieldMap_input(1) ! currently the size must equal 1 for rank 2 fieldds + character(len=CL) :: errmsg + character(len=CL) :: msg character(len=*),parameter :: subname=' (med_merge_mod: med_merge)' !--------------------------------------- @@ -258,14 +260,19 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld !------------------------- ! Get field pointer to output field - call ESMF_FieldBundleGet(FBout, fieldName=trim(FBoutfld), field=lfield, rc=rc) + call ESMF_FieldBundleGet(FBout, trim(FBoutfld), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, rank=lrank, rc=rc) + call ESMF_FieldGet(lfield, rank=lrank_output, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (lrank == 1) then + if (dbug_flag > 1) then + write(msg,*)trim(subname),'output field ',trim(FBoutfld),' has rank ',lrank_output + call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO) + end if + + if (lrank_output == 1) then call ESMF_FieldGet(lfield, farrayPtr=dp1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - else if (lrank == 2) then + else if (lrank_output == 2) then call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound_output, & gridToFieldMap=gridToFieldMap_output, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -274,14 +281,19 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld end if ! Get field pointer to input field used in the merge - call ESMF_FieldBundleGet(FB, fieldName=trim(FBfld), field=lfield, rc=rc) + call ESMF_FieldBundleGet(FB, FBfld, field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, rank=lrank, rc=rc) + call ESMF_FieldGet(lfield, rank=lrank_input, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (lrank == 1) then + if (dbug_flag > 1) then + write(msg,*)trim(subname),'input field ',trim(FBfld),' has rank ',lrank_input + call ESMF_LogWrite(msg, ESMF_LOGMSG_ERROR) + end if + + if (lrank_input == 1) then call ESMF_FieldGet(lfield, farrayPtr=dpf1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - else if (lrank == 2) then + else if (lrank_input == 2) then call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound_input, & gridToFieldMap=gridToFieldMap_input, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -290,22 +302,28 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld end if ! error checks - if (lrank == 2) then + if (lrank_input /= lrank_output) then + write(errmsg,*) trim(subname),' input field rank ',lrank_input,' for '//trim(FBfld), & + ' not equal to output field rank ',lrank_output,' for '//trim(FBoutfld) + call ESMF_LogWrite(errmsg, ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + else if (lrank_output == 2) then if (ungriddedUBound_output(1) /= ungriddedUBound_input(1)) then write(errmsg,*) trim(subname),"ungriddedUBound_input (",ungriddedUBound_input(1),& - ") not equal to ungriddedUBound_output (",ungriddedUBound_output(1),")" + ") not equal to ungriddedUBound_output (",ungriddedUBound_output(1),") for "//trim(FBoutfld) call ESMF_LogWrite(errmsg, ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return else if (gridToFieldMap_input(1) /= gridToFieldMap_output(1)) then write(errmsg,*) trim(subname),"gridtofieldmap_input (",gridtofieldmap_input(1),& - ") not equal to gridtofieldmap_output (",gridtofieldmap_output(1),")" + ") not equal to gridtofieldmap_output (",gridtofieldmap_output(1),") for "//trim(FBoutfld) call ESMF_LogWrite(errmsg, ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE return end if endif + ! Get pointer to weights that weights are only rank 1 if (merge_type == 'copy_with_weights' .or. merge_type == 'merge' .or. merge_type == 'sum_with_weights') then call ESMF_FieldBundleGet(FBw, fieldName=trim(fldw), field=lfield, rc=rc) @@ -316,13 +334,13 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld ! Do supported merges if (trim(merge_type) == 'copy') then - if (lrank == 1) then + if (lrank_output == 1) then dp1(:) = dpf1(:) else dp2(:,:) = dpf2(:,:) endif else if (trim(merge_type) == 'copy_with_weights') then - if (lrank == 1) then + if (lrank_output == 1) then dp1(:) = dpf1(:)*dpw1(:) else do n = 1,ungriddedUBound_input(1) @@ -334,7 +352,7 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld end do endif else if (trim(merge_type) == 'merge' .or. trim(merge_type) == 'sum_with_weights') then - if (lrank == 1) then + if (lrank_output == 1) then dp1(:) = dp1(:) + dpf1(:)*dpw1(:) else do n = 1,ungriddedUBound_input(1) @@ -346,7 +364,7 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld end do endif else if (trim(merge_type) == 'sum') then - if (lrank == 1) then + if (lrank_output == 1) then dp1(:) = dp1(:) + dpf1(:) else dp2(:,:) = dp2(:,:) + dpf2(:,:) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 2db2aace4..8e2dbf9f6 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -42,8 +42,8 @@ module med_phases_history_mod public :: med_phases_history_alarm_init public :: med_phases_history_write - ! type(ESMF_Alarm) :: alarm_hist_inst - ! type(ESMF_Alarm) :: alarm_hist_avg + ! type(ESMF_Alarm) :: alarm_hist_inst + ! type(ESMF_Alarm) :: alarm_hist_avg character(*), parameter :: u_FILE_u = & __FILE__ @@ -127,18 +127,19 @@ subroutine med_phases_history_alarm_init(gcomp, rc) ! Set alarm for averaged mediator history output ! ----------------------------- - call NUOPC_CompAttributeGet(gcomp, name='histavg_option', value=histavg_option, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name='histavg_n', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) histavg_n + !TODO: add isSet and isPresent flags to reading these and other config attributes + !call NUOPC_CompAttributeGet(gcomp, name='histavg_option', value=histavg_option, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !call NUOPC_CompAttributeGet(gcomp, name='histavg_n', value=cvalue, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !read(cvalue,*) histavg_n - call med_time_alarmInit(mclock, alarm, option=histavg_option, opt_n=histavg_n, & - reftime=mStartTime, alarmname='alarm_history_avg', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !call med_time_alarmInit(mclock, alarm, option=histavg_option, opt_n=histavg_n, & + ! reftime=mStartTime, alarmname='alarm_history_avg', rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Advance model clock to trigger alarms then reset model clock back to currtime @@ -164,8 +165,8 @@ subroutine med_phases_history_alarm_init(gcomp, rc) write(logunit,100) trim(subname)//" history clock timestep = ",timestep_length write(logunit,100) trim(subname)//" set instantaneous mediator history alarm with option "//& trim(histinst_option)//" and frequency ",histinst_n - write(logunit,100) trim(subname)//" set averaged mediator history alarm with option "//& - trim(histavg_option)//" and frequency ",histavg_n + !write(logunit,100) trim(subname)//" set averaged mediator history alarm with option "//& + ! trim(histavg_option)//" and frequency ",histavg_n 100 format(a,2x,i8) write(logunit,*) end if @@ -213,7 +214,6 @@ subroutine med_phases_history_write(gcomp, rc) integer :: alarmCount type(ESMF_VM) :: vm 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 @@ -301,30 +301,31 @@ subroutine med_phases_history_write(gcomp, rc) ! alarmisOn = .false. ! endif - !DEBUG call ESMF_ClockGetAlarm(mclock, alarmname='alarm_history_inst', alarm=alarm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_AlarmGet(alarm, ringInterval=ringInterval, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeIntervalGet(ringInterval, s=ringinterval_length, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(mclock, currtime=currtime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - if (mastertask .and. dbug_flag>2) then - write(logunit,*) - write(logunit,*) trim(subname)//": history alarm ringinterval = ", ringInterval_length - write(logunit,' (a)') trim(subname)//": currtime = "//trim(currtimestr)//" nexttime = "//trim(nexttimestr) - write(logunit,*) trim(subname) //' history alarm is ringing = ', ESMF_AlarmIsRinging(alarm) + + if (dbug_flag > 2) then + call ESMF_AlarmGet(alarm, ringInterval=ringInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeIntervalGet(ringInterval, s=ringinterval_length, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(mclock, currtime=currtime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) then + write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + write(logunit,*) + write(logunit,*) trim(subname)//": history alarm ringinterval = ", ringInterval_length + write(logunit,' (a)') trim(subname)//": currtime = "//trim(currtimestr)//" nexttime = "//trim(nexttimestr) + write(logunit,*) trim(subname) //' history alarm is ringing = ', ESMF_AlarmIsRinging(alarm) + end if end if - !DEBUG if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -337,7 +338,7 @@ subroutine med_phases_history_write(gcomp, rc) call ESMF_GridCompGet(gcomp, clock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(mclock, currtime=currtime, reftime=reftime, starttime=starttime, calendar=calendar, rc=rc) + call ESMF_ClockGet(mclock, currtime=currtime, starttime=starttime, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) @@ -350,12 +351,12 @@ subroutine med_phases_history_write(gcomp, rc) call ESMF_TimeGet(nexttime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - timediff = nexttime - reftime + timediff = nexttime - starttime call ESMF_TimeIntervalGet(timediff, d=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return dayssince = day + sec/real(SecPerDay,R8) - call ESMF_TimeGet(reftime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_ymd2date(yr,mon,day,start_ymd) start_tod = sec @@ -427,6 +428,7 @@ subroutine med_phases_history_write(gcomp, rc) call med_io_write(hist_file, iam, is_local%wrap%FBMed_ocnalb_o, & nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='Med_alb_ocn', rc=rc) end if + !TODO: don't write aoflux_(oa) when they're not being used if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o,rc=rc)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 14c7dd3c9..6d221f0b3 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -251,6 +251,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) 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 + character(CL) :: msg logical :: first_call = .true. character(len=*) , parameter :: subname='(med_phases_ocnalb_run)' !--------------------------------------- @@ -299,7 +300,12 @@ subroutine med_phases_ocnalb_run(gcomp, rc) call t_startf('MED:'//subname) + ! get clock + call ESMF_GridCompGet(gcomp, clock=clock) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (first_call) then + ! Initialize ocean albedo calculation call med_phases_ocnalb_init(gcomp, ocnalb, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -320,8 +326,6 @@ subroutine med_phases_ocnalb_run(gcomp, rc) return end if - call ESMF_GridCompGet(gcomp, clock=clock) - if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet( clock, currTime=currTime, timeStep=timeStep, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -376,6 +380,9 @@ subroutine med_phases_ocnalb_run(gcomp, rc) else ! Solar declination ! Will only do albedo calculation if nextsw_cday is not -1. + write(msg,*)trim(subname)//' nextsw_cday = ',nextsw_cday + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + if (nextsw_cday >= -0.5_r8) then call shr_orb_decl(nextsw_cday, eccen, mvelpp,lambm0, obliqr, delta, eccf) diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index e19bfe037..5752ec906 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -155,7 +155,9 @@ subroutine med_phases_prep_ice(gcomp, rc) end if if (trim(coupling_mode(1:4)) == 'nems') then - + !TODO: the EMC CICE5 cap calculates Sa_ptem; the Sa_ptem is not an exchanged field + !so the calcuation here is un-used. It should be retained however for eventual use after + !a unified CICE6 cap is implemented ! If either air density or ptem from atm is not available - then need pbot since it will be ! required for either calculation if ( .not. fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_dens',rc=rc) .or. & diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 32a54e6d6..cc32a43a7 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -72,8 +72,8 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! get start time - call ESMF_ClockGet(mclock, startTime=mStartTime, rc=rc) + ! get current time + call ESMF_ClockGet(mclock, currTime=mCurrTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ----------------------------- @@ -87,7 +87,7 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) read(cvalue,*) restart_n call med_time_alarmInit(mclock, alarm, option=restart_option, opt_n=restart_n, & - reftime=mStartTime, alarmname='alarm_restart', rc=rc) + reftime=mcurrTime, alarmname='alarm_restart', rc=rc) call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -146,7 +146,9 @@ subroutine med_phases_restart_write(gcomp, rc) ! local variables type(ESMF_VM) :: vm type(ESMF_Clock) :: clock - type(ESMF_Time) :: currtime, reftime, starttime, nexttime + type(ESMF_Time) :: starttime + type(ESMF_Time) :: currtime + type(ESMF_Time) :: nexttime type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time type(ESMF_Alarm) :: alarm type(ESMF_Calendar) :: calendar @@ -158,13 +160,11 @@ subroutine med_phases_restart_write(gcomp, rc) 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 + real(R8) :: dayssince ! Time interval since start time integer :: unitn ! unit number character(ESMF_MAXSTR) :: time_units ! units of time variable character(ESMF_MAXSTR) :: case_name ! case name @@ -178,8 +178,7 @@ subroutine med_phases_restart_write(gcomp, rc) 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 + character(ESMF_MAXSTR) :: tmpstr logical :: isPresent logical :: first_time = .true. character(len=*), parameter :: subname='(med_phases_restart_write)' @@ -187,7 +186,7 @@ subroutine med_phases_restart_write(gcomp, rc) call t_startf('MED:'//subname) if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -246,7 +245,7 @@ subroutine med_phases_restart_write(gcomp, rc) endif if (alarmIsOn) then - call ESMF_ClockGet(clock, currtime=currtime, reftime=reftime, starttime=starttime, rc=rc) + call ESMF_ClockGet(clock, currtime=currtime, starttime=starttime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) @@ -255,45 +254,43 @@ subroutine med_phases_restart_write(gcomp, rc) call ESMF_ClockGet(clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) + call ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO) endif - call ESMF_TimeGet(nexttime,yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) + call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": nexttime = "//trim(nexttimestr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": nexttime = "//trim(nexttimestr), ESMF_LOGMSG_INFO) endif if (mastertask) then - call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//& - " mediating for: ", unit=cvalue, rc=rc) + call ESMF_ClockPrint(clock, options="currTime", & + preString="-------->"//trim(subname)//" mediating for: ", unit=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(logunit, *) trim(cvalue) endif - timediff = nexttime - reftime + timediff = nexttime - starttime 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) + call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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, rc) + time_units = 'days since '//trim(med_io_date2yyyymmdd(start_ymd))//' '//med_io_sec2hms(start_tod, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) + call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec) + if (ChkErr(rc,__LINE__,u_FILE_u)) return 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 ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ymd2date(yr,mon,day,curr_ymd) curr_tod = sec @@ -303,18 +300,17 @@ subroutine med_phases_restart_write(gcomp, rc) ! 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' + write(restart_file,"(6a)") trim(case_name),'.cpl',trim(cpl_inst_tag),'.r.',trim(nexttimestr),'.nc' if (iam == 0) then restart_pfile = "rpointer.cpl"//cpl_inst_tag - call ESMF_LogWrite(trim(subname)//" write rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//" write rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED') write(unitn,'(a)') trim(restart_file) close(unitn) endif - call ESMF_LogWrite(trim(subname)//": write "//trim(restart_file), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": write "//trim(restart_file), ESMF_LOGMSG_INFO) call med_io_wopen(restart_file, vm, iam, clobber=.true.) do m = 1,2 @@ -330,7 +326,7 @@ subroutine med_phases_restart_write(gcomp, rc) end if tbnds = dayssince - call ESMF_LogWrite(trim(subname)//": time "//trim(time_units), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": time "//trim(time_units), ESMF_LOGMSG_INFO) if (tbnds(1) >= tbnds(2)) then call med_io_write(restart_file, iam=iam, & time_units=time_units, calendar=calendar, time_val=dayssince, & @@ -351,10 +347,6 @@ subroutine med_phases_restart_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_write(restart_file, iam, start_tod, 'start_tod', whead=whead, wdata=wdata, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, iam, ref_ymd , 'ref_ymd' , whead=whead, wdata=wdata, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, iam, ref_tod , 'ref_tod' , whead=whead, wdata=wdata, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_write(restart_file, iam, next_ymd , 'curr_ymd' , whead=whead, wdata=wdata, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_write(restart_file, iam, next_tod , 'curr_tod' , whead=whead, wdata=wdata, rc=rc) @@ -375,7 +367,7 @@ subroutine med_phases_restart_write(gcomp, rc) ! Write import field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny - !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) 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 (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -384,7 +376,7 @@ subroutine med_phases_restart_write(gcomp, rc) ! Write export field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny - !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) call med_io_write(restart_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 (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -393,7 +385,7 @@ subroutine med_phases_restart_write(gcomp, rc) ! Write fraction field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny - !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) 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 (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -403,7 +395,7 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccum(n),rc=rc)) then ! TODO: only write this out if actually have done accumulation !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny - !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) 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 (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -413,7 +405,7 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBImpAccum(n,n),rc=rc)) then ! TODO: only write this out if actually have done accumulation !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny - !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) call med_io_write(restart_file, iam, is_local%wrap%FBImpAccum(n,n), & nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'ImpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -443,7 +435,7 @@ subroutine med_phases_restart_write(gcomp, rc) !--------------------------------------- if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif call t_stopf('MED:'//subname) @@ -481,13 +473,12 @@ subroutine med_phases_restart_read(gcomp, rc) 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 - integer :: dbrc logical :: isPresent character(len=*), parameter :: sp_str = 'str_undefined' character(len=*), parameter :: subname='(med_phases_restart_read)' !--------------------------------------- call t_startf('MED:'//subname) - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS !--------------------------------------- @@ -525,11 +516,11 @@ subroutine med_phases_restart_read(gcomp, rc) call ESMF_ClockGet(clock, currtime=currtime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) + call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO) endif if (iam==0) then call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//" mediating for: ", rc=rc) @@ -544,25 +535,25 @@ subroutine med_phases_restart_read(gcomp, rc) restart_pfile = "rpointer.cpl"//cpl_inst_tag if (iam == 0) then - call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) open(newunit=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) + call ESMF_LogWrite(trim(subname)//' rpointer file open returns error', ESMF_LOGMSG_INFO) 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) + call ESMF_LogWrite(trim(subname)//' rpointer file read returns error', ESMF_LOGMSG_INFO) rc=ESMF_Failure return end if close(unitn) - call ESMF_LogWrite(trim(subname)//' restart file from rpointer = '//trim(restart_file), & - ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//' restart file from rpointer = '//trim(restart_file), ESMF_LOGMSG_INFO) 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) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": read "//trim(restart_file), ESMF_LOGMSG_INFO) ! Now read in the restart file @@ -575,36 +566,31 @@ subroutine med_phases_restart_read(gcomp, rc) 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) + call med_io_read(restart_file, vm, iam, is_local%wrap%FBimp(n,n), pre=trim(compname(n))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Read export field bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExp(n),rc=rc)) then - call med_io_read(restart_file, vm, iam, is_local%wrap%FBexp(n), & - pre=trim(compname(n))//'Exp', rc=rc) + call med_io_read(restart_file, vm, iam, is_local%wrap%FBexp(n), pre=trim(compname(n))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Read fraction field bundles 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) + call med_io_read(restart_file, vm, iam, is_local%wrap%FBfrac(n), pre=trim(compname(n))//'Frac', rc=rc) if (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) + call med_io_read(restart_file, vm, iam, is_local%wrap%FBExpAccum(n), pre=trim(compname(n))//'ExpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Read import field bundle accumulator if (ESMF_FieldBundleIsCreated(is_local%wrap%FBImpAccum(n,n),rc=rc)) then - call med_io_read(restart_file, vm, iam, is_local%wrap%FBImpAccum(n,n), & - pre=trim(compname(n))//'ImpAccum', rc=rc) + call med_io_read(restart_file, vm, iam, is_local%wrap%FBImpAccum(n,n), pre=trim(compname(n))//'ImpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif endif @@ -612,8 +598,7 @@ subroutine med_phases_restart_read(gcomp, rc) ! 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) + call med_io_read(restart_file, vm, iam, is_local%wrap%FBMed_ocnalb_o, pre='MedOcnAlb_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -621,7 +606,7 @@ subroutine med_phases_restart_read(gcomp, rc) !--- clean up !--------------------------------------- - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) call t_stopf('MED:'//subname) end subroutine med_phases_restart_read diff --git a/nuopc_cap_share/nuopc_shr_methods.F90 b/nuopc_cap_share/nuopc_shr_methods.F90 new file mode 100644 index 000000000..44ead6c8f --- /dev/null +++ b/nuopc_cap_share/nuopc_shr_methods.F90 @@ -0,0 +1,845 @@ +module nuopc_shr_methods + + use ESMF , only : operator(<), operator(/=), operator(+) + use ESMF , only : operator(-), operator(*) , operator(>=) + use ESMF , only : operator(<=), operator(>), operator(==) + use ESMF , only : ESMF_LOGERR_PASSTHRU, ESMF_LogFoundError, ESMF_LOGMSG_ERROR, ESMF_MAXSTR + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE + use ESMF , only : ESMF_State, ESMF_StateGet + use ESMF , only : ESMF_Field, ESMF_FieldGet + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_GridCompSet + use ESMF , only : ESMF_GeomType_Flag, ESMF_FieldStatus_Flag + use ESMF , only : ESMF_Mesh, ESMF_MeshGet + use ESMF , only : ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID, ESMF_FIELDSTATUS_COMPLETE + use ESMF , only : ESMF_Clock, ESMF_ClockCreate, ESMF_ClockGet, ESMF_ClockSet + use ESMF , only : ESMF_ClockPrint, ESMF_ClockAdvance + use ESMF , only : ESMF_Alarm, ESMF_AlarmCreate, ESMF_AlarmGet, ESMF_AlarmSet + use ESMF , only : ESMF_Calendar, 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_VM, ESMF_VMGet, ESMF_VMBroadcast, ESMF_VMGetCurrent + use NUOPC , only : NUOPC_CompAttributeGet + use NUOPC_Model , only : NUOPC_ModelGet + use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_sys_mod , only : shr_sys_abort + use shr_file_mod , only : shr_file_setlogunit, shr_file_getLogUnit + + implicit none + private + + public :: memcheck + public :: get_component_instance + public :: set_component_logging + public :: log_clock_advance + public :: state_getscalar + public :: state_setscalar + public :: state_diagnose + public :: alarmInit + public :: chkerr + + private :: timeInit + private :: field_getfldptr + + ! 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" + + ! Module data + integer, parameter :: SecPerDay = 86400 ! Seconds per day + integer, parameter :: memdebug_level=1 + character(len=1024) :: msgString + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine memcheck(string, level, mastertask) + + ! input/output variables + character(len=*) , intent(in) :: string + integer , intent(in) :: level + logical , intent(in) :: mastertask + + ! local variables + integer :: ierr + integer, external :: GPTLprint_memusage + !----------------------------------------------------------------------- + + if ((mastertask .and. memdebug_level > level) .or. memdebug_level > level+1) then + ierr = GPTLprint_memusage(string) + endif + + end subroutine memcheck + +!=============================================================================== + + subroutine get_component_instance(gcomp, inst_suffix, inst_index, rc) + + ! input/output variables + type(ESMF_GridComp) :: gcomp + character(len=*) , intent(out) :: inst_suffix + integer , intent(out) :: inst_index + integer , intent(out) :: rc + + ! local variables + logical :: isPresent + character(len=4) :: cvalue + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (isPresent) then + call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", value=inst_suffix, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + cvalue = inst_suffix(2:) + read(cvalue, *) inst_index + else + inst_suffix = "" + inst_index=1 + endif + + end subroutine get_component_instance + +!=============================================================================== + + subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) + + ! input/output variables + type(ESMF_GridComp) :: gcomp + logical, intent(in) :: mastertask + integer, intent(out) :: logunit + integer, intent(out) :: shrlogunit + integer, intent(out) :: rc + + ! local variables + character(len=CL) :: diro + character(len=CL) :: logfile + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + shrlogunit = 6 + + if (mastertask) then + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) + if (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 set_component_logging + +!=============================================================================== + + subroutine log_clock_advance(clock, component, logunit, rc) + + ! input/output variables + type(ESMF_Clock) :: clock + character(len=*) , intent(in) :: component + integer , intent(in) :: logunit + integer , intent(out) :: rc + + ! local variables + character(len=CL) :: cvalue, prestring + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + write(prestring, *) "------>Advancing ",trim(component)," from: " + call ESMF_ClockPrint(clock, options="currTime", unit=cvalue, preString=trim(prestring), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(logunit, *) trim(cvalue) + + call ESMF_ClockPrint(clock, options="stopTime", unit=cvalue, & + preString="--------------------------------> to: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(logunit, *) trim(cvalue) + + end subroutine log_clock_advance + +!=============================================================================== + + subroutine state_getscalar(state, scalar_id, scalar_value, flds_scalar_name, flds_scalar_num, rc) + + ! ---------------------------------------------- + ! Get scalar data from State for a particular name and broadcast it to all other pets + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State), intent(in) :: state + integer, intent(in) :: scalar_id + real(r8), intent(out) :: scalar_value + character(len=*), intent(in) :: flds_scalar_name + integer, intent(in) :: flds_scalar_num + integer, intent(inout) :: rc + + ! local variables + integer :: mytask, ierr, len + type(ESMF_VM) :: vm + type(ESMF_Field) :: field + real(r8), pointer :: farrayptr(:,:) + real(r8) :: tmp(1) + character(len=*), parameter :: subname='(state_getscalar)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_VMGetCurrent(vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (mytask == 0) then + call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then + call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + endif + tmp(:) = farrayptr(scalar_id,:) + endif + call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + scalar_value = tmp(1) + + end subroutine state_getscalar + +!================================================================================ + + subroutine state_setscalar(scalar_value, scalar_id, State, flds_scalar_name, flds_scalar_num, rc) + + ! ---------------------------------------------- + ! Set scalar data from State for a particular name + ! ---------------------------------------------- + + ! input/output arguments + real(r8), intent(in) :: scalar_value + integer, intent(in) :: scalar_id + type(ESMF_State), intent(inout) :: State + character(len=*), intent(in) :: flds_scalar_name + integer, intent(in) :: flds_scalar_num + integer, intent(inout) :: rc + + ! local variables + integer :: mytask + type(ESMF_Field) :: lfield + type(ESMF_VM) :: vm + real(r8), pointer :: farrayptr(:,:) + character(len=*), parameter :: subname='(state_setscalar)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_VMGetCurrent(vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (mytask == 0) then + call ESMF_FieldGet(lfield, farrayPtr = farrayptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then + call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + endif + farrayptr(scalar_id,1) = scalar_value + endif + + end subroutine state_setscalar + +!=============================================================================== + + subroutine state_diagnose(State, string, rc) + + ! ---------------------------------------------- + ! Diagnose status of State + ! ---------------------------------------------- + + type(ESMF_State), intent(in) :: state + character(len=*), intent(in) :: string + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + type(ESMf_Field) :: lfield + integer :: fieldCount, lrank + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + real(r8), pointer :: dataPtr1d(:) + real(r8), pointer :: dataPtr2d(:,:) + character(len=*),parameter :: subname='(state_diagnose)' + ! ---------------------------------------------- + + call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + + call ESMF_StateGet(state, itemNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + + call ESMF_StateGet(state, itemName=lfieldnamelist(n), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call field_getfldptr(lfield, fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + if (size(dataPtr1d) > 0) then + write(msgString,'(A,a)') trim(string)//': for 1d field '//trim(lfieldnamelist(n)) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + write(msgString,'(A,3g14.7,i8)') trim(string)//': 1d field '//trim(lfieldnamelist(n)), & + minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + else + write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data" + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + endif + elseif (lrank == 2) then + if (size(dataPtr2d) > 0) then + write(msgString,'(A,a)') trim(string)//': for 2d field '//trim(lfieldnamelist(n)) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + write(msgString,'(A,3g14.7,i8)') trim(string)//': 2d field '//trim(lfieldnamelist(n)), & + minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + else + write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data" + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + endif + else + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + enddo + + deallocate(lfieldnamelist) + + end subroutine state_diagnose + +!=============================================================================== + + subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) + + ! ---------------------------------------------- + ! for a field, determine rank and return fldptr1 or fldptr2 + ! abort is true by default and will abort if fldptr is not yet allocated in field + ! rank returns 0, 1, or 2. 0 means fldptr not allocated and abort=false + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_Field) , intent(in) :: field + real(r8), pointer , intent(inout), optional :: fldptr1(:) + real(r8), pointer , intent(inout), optional :: fldptr2(:,:) + integer , intent(out) , optional :: rank + logical , intent(in) , optional :: abort + integer , intent(out) , optional :: rc + + ! local variables + type(ESMF_GeomType_Flag) :: geomtype + type(ESMF_FieldStatus_Flag) :: status + type(ESMF_Mesh) :: lmesh + integer :: lrank, nnodes, nelements + logical :: labort + character(len=*), parameter :: subname='(field_getfldptr)' + ! ---------------------------------------------- + + if (.not.present(rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR rc not present ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + + rc = ESMF_SUCCESS + + labort = .true. + if (present(abort)) then + labort = abort + endif + lrank = -99 + + call ESMF_FieldGet(field, status=status, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (status /= ESMF_FIELDSTATUS_COMPLETE) then + lrank = 0 + if (labort) then + call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + else + call ESMF_LogWrite(trim(subname)//": WARNING data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + endif + else + + call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + elseif (geomtype == ESMF_GEOMTYPE_MESH) then + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, mesh=lmesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (nnodes == 0 .and. nelements == 0) lrank = 0 + else + call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", & + ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + endif ! geomtype + + if (lrank == 0) then + call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", & + ESMF_LOGMSG_INFO) + elseif (lrank == 1) then + if (.not.present(fldptr1)) then + call ESMF_LogWrite(trim(subname)//": ERROR missing rank=1 array ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + call ESMF_FieldGet(field, farrayPtr=fldptr1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + elseif (lrank == 2) then + if (.not.present(fldptr2)) then + call ESMF_LogWrite(trim(subname)//": ERROR missing rank=2 array ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + call ESMF_FieldGet(field, farrayPtr=fldptr2, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//": ERROR in rank ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + + endif ! status + + if (present(rank)) then + rank = lrank + endif + + end subroutine field_getfldptr + +!=============================================================================== + + subroutine alarmInit( clock, alarm, option, & + opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) + + ! 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 = '(set_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 (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! initial guess of next alarm, this will be updated below + 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 (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optNever) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optDate) + if (.not. present(opt_ymd)) then + call shr_sys_abort(subname//trim(option)//' requires opt_ymd') + end if + if (lymd < 0 .or. ltod < 0) then + call shr_sys_abort(subname//trim(option)//'opt_ymd, opt_tod invalid') + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call timeInit(NextAlarm, lymd, cal, ltod, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optIfdays0) + if (.not. present(opt_ymd)) then + call shr_sys_abort(subname//trim(option)//' requires opt_ymd') + end if + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (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 (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + case (optNSteps) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNStep) + if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') + if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') + call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNSeconds) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNSecond) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMinutes) + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_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_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNHours) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNHour) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNDays) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNDay) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMonths) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMonth) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (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 (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + case (optNYears) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNYear) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (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 (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + case default + call shr_sys_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 (chkerr(rc,__LINE__,u_FILE_u)) return + + end subroutine alarmInit + +!=============================================================================== + + subroutine timeInit( Time, ymd, cal, tod, rc) + + ! 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) :: tod ! time of day in seconds + integer , intent(out) :: rc + + ! local variables + integer :: year, mon, day ! year, month, day as integers + integer :: tdate ! temporary date + integer :: date ! coded-date (yyyymmdd) + character(len=*), parameter :: subname='(timeInit)' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + if ( (ymd < 0) .or. (tod < 0) .or. (tod > SecPerDay) )then + call shr_sys_abort( subname//'ERROR yymmdd is a negative number or time-of-day out of bounds' ) + end if + + tdate = abs(date) + year = int(tdate/10000) + if (date < 0) year = -year + mon = int( mod(tdate,10000)/ 100) + day = mod(tdate, 100) + + call ESMF_TimeSet( Time, yy=year, mm=mon, dd=day, s=tod, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + end subroutine timeInit + +!=============================================================================== + + logical function chkerr(rc, line, file) + + integer, intent(in) :: rc + integer, intent(in) :: line + character(len=*), intent(in) :: file + + integer :: lrc + + chkerr = .false. + lrc = rc + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then + chkerr = .true. + endif + end function chkerr + +end module nuopc_shr_methods From 49b7cecc8e3a1aef8ce41b1eff19a5ce861da6ce Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Fri, 17 Apr 2020 07:44:41 -0400 Subject: [PATCH 02/32] merge escomp/cmeps master (#6) * added new prealpha test that does not have threading on for now * fix Makefile, log message print * bug fixes for prealpha tests * bug fixes for B1850 * fix problems with ocnalb calculation on intialization * update fd_nems.yaml for wave field, turn off profiling and histavg variables * udpates for esmf8.1 * make esmf8.0 and esmf8.1 compatible * changes to get nuopc to run without a mediator and bug fixes * updates with additional TODO notes * changes to have nuopc cases run without a mediator * updates to fix problem in running compsets with no mediator * fixes for running without a mediator and for running IRT tests * updates for cleaner nuopc.runconfig * update pio_stride * fix spelling error * this is a bugfix * add nuopc_share_methods for caps * change N3 test to use default pelayout Co-authored-by: Mariana Vertenstein Co-authored-by: Jim Edwards From b9c1d6e459247e66280578d24d2c0daf4057cfe7 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Fri, 17 Apr 2020 07:55:50 -0400 Subject: [PATCH 03/32] Revert "merge escomp/cmeps master (#5)" This reverts commit 5a4c5ee90927de8f52e02520d93bdeb09e7d2599. --- cime_config/buildexe | 24 +- cime_config/buildnml | 122 +- cime_config/config_archive.xml | 2 +- cime_config/config_component.xml | 36 +- cime_config/namelist_definition_drv.xml | 1357 ++++++++++---------- cime_config/testdefs/testlist_prealpha.xml | 529 -------- drivers/cime/ensemble_driver.F90 | 231 ++-- drivers/cime/esm.F90 | 499 +++++-- drivers/cime/esm_time_mod.F90 | 404 ++---- drivers/cime/esm_utils_mod.F90 | 55 - mediator/Makefile | 4 +- mediator/esmFlds.F90 | 65 +- mediator/esmFldsExchange_cesm_mod.F90 | 15 +- mediator/fd_nems.yaml | 2 - mediator/med.F90 | 92 +- mediator/med_merge_mod.F90 | 72 +- mediator/med_phases_history_mod.F90 | 80 +- mediator/med_phases_ocnalb_mod.F90 | 11 +- mediator/med_phases_prep_ice_mod.F90 | 4 +- mediator/med_phases_restart_mod.F90 | 117 +- nuopc_cap_share/nuopc_shr_methods.F90 | 845 ------------ 21 files changed, 1610 insertions(+), 2956 deletions(-) delete mode 100644 cime_config/testdefs/testlist_prealpha.xml delete mode 100644 drivers/cime/esm_utils_mod.F90 delete mode 100644 nuopc_cap_share/nuopc_shr_methods.F90 diff --git a/cime_config/buildexe b/cime_config/buildexe index 83d211ac9..f79f1d451 100755 --- a/cime_config/buildexe +++ b/cime_config/buildexe @@ -32,27 +32,12 @@ def _main_func(): exeroot = case.get_value("EXEROOT") gmake = case.get_value("GMAKE") gmake_j = case.get_value("GMAKE_J") - cime_model = case.get_value("MODEL") + cime_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") gmake_args = get_standard_makefile_args(case) - # Determine valid components - valid_comps = [] - for item in case.get_values("COMP_CLASSES"): - comp = case.get_value("COMP_" + item) - valid = True - if comp == 's' + item.lower(): - valid = False - if valid: - valid_comps.append(item) - - if len(valid_comps) == 2 and "dwav" not in case.get_value("COMP_WAV") and "dlnd" not in case.get_value("COMP_LND"): - skip_mediator = True - else: - skip_mediator = False - if ocn_model == 'mom' or atm_model == "ufsatm": gmake_args += "USE_FMS=TRUE" @@ -62,18 +47,15 @@ def _main_func(): stubcomp = "s{}".format(comp.lower()) if model == stubcomp: gmake_args += " {}_PRESENT=FALSE".format(comp) - if skip_mediator: - gmake_args += " MED_PRESENT=FALSE" - gmake_args += " IAC_PRESENT=FALSE" expect((num_esp is None) or (int(num_esp) == 1), "ESP component restricted to one instance") with open('Filepath', 'w') as out: - if not skip_mediator: - out.write(os.path.join(cimeroot, "src", "drivers", "nuopc", "mediator") + "\n") out.write(os.path.join(caseroot, "SourceMods", "src.drv") + "\n") + out.write(os.path.join(cimeroot, "src", "drivers", "nuopc", "mediator") + "\n") out.write(os.path.join(cimeroot, "src", "drivers", "nuopc", "drivers", "cime") + "\n") + # build model executable makefile = os.path.join(casetools, "Makefile") diff --git a/cime_config/buildnml b/cime_config/buildnml index 7eae6d364..dc525a573 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -216,48 +216,37 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): # (3) Write nuopc.runconfig file and add to input dataset list. #-------------------------------- - # Determine valid components - valid_comps = [] - for item in case.get_values("COMP_CLASSES"): - comp = case.get_value("COMP_" + item) - valid = True + # 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 comp == 's' + item.lower(): - valid = False + 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 - elif comp == 'x' + item.lower(): - if item != 'ESP': #no esp xcpl component - if case.get_value(item + "_NX") == "0" and case.get_value(item + "_NY") == "0": - valid = False - # special case - mosart or rtm in NULL mode - elif (case.get_value("COMP_ROF") == 'mosart' or case.get_value("COMP_ROF") == 'rtm'): - if (case.get_value("MOSART_MODE") == 'NULL' or case.get_value("RTM_MODE") == 'NULL'): - valid = False - if valid: - valid_comps.append(item) - - # set the driver rpointer file if there is only one non-stub component then skip mediator - - if len(valid_comps) == 2 and "dwav" not in case.get_value("COMP_WAV") and "dlnd" not in case.get_value("COMP_LND"): - skip_mediator = True - valid_comps.remove("CPL") - nmlgen.set_value('mediator_present', value='.false.') - nmlgen.set_value("drv_restart_pointer", value="none") - nmlgen.set_value("component_list", value=" ".join(valid_comps)) - else: - skip_mediator = False - nmlgen.set_value("drv_restart_pointer", value="rpointer.cpl") - valid_comps_string = " ".join(valid_comps) - nmlgen.set_value("component_list", value=valid_comps_string.replace("CPL","MED")) + 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) + # special case - mosart or rtm in NULL mode + if (case.get_value("COMP_ROF") == 'mosart' or case.get_value("COMP_ROF") == 'rtm'): + if (case.get_value("MOSART_MODE") == 'NULL' or case.get_value("RTM_MODE") == 'NULL'): + skip_comps.append('ROF') + + logger.info("Writing nuopc_runseq will skip components {}".format(skip_comps)) - logger.info("Writing nuopc_runseq for components {}".format(valid_comps)) nuopc_config_file = os.path.join(confdir, "nuopc.runconfig") - nmlgen.write_nuopc_config_file(nuopc_config_file, data_list_path=data_list_path) + 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, valid_comps) + _create_runseq(case, coupling_times) #-------------------------------- # (5) Write drv_flds_in @@ -305,57 +294,42 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): nmlgen.write_output_file(drv_flds_in) ############################################################################### -def _create_runseq(case, coupling_times, valid_comps): +def _create_runseq(case, coupling_times): ############################################################################### caseroot = case.get_value("CASEROOT") user_file = os.path.join(caseroot, "nuopc.runseq") - rundir = case.get_value("RUNDIR") - if os.path.exists(user_file): # Determine if there is a user run sequence file in CASEROOT, use it + rundir = case.get_value("RUNDIR") 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: - if len(valid_comps) == 1: - - # Create run sequence with no mediator - outfile = open(os.path.join(caseroot, "CaseDocs", "nuopc.runseq"), "w") - dtime = coupling_times[valid_comps[0].lower() + '_cpl_dt'] - outfile.write ("runSeq:: \n") - outfile.write ("@" + str(dtime) + " \n") - outfile.write (" " + valid_comps[0] + " \n") - outfile.write ("@ \n") - outfile.write (":: \n") - outfile.close() - shutil.copy(os.path.join(caseroot, "CaseDocs", "nuopc.runseq"), rundir) - - else: + # Create a run sequence file appropriate for target compset - # Create a run sequence file appropriate for target compset - 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_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") - sys.path.append(os.path.join(_CIMEROOT, "src", "drivers", "nuopc", "cime_config", "runseq")) + sys.path.append(os.path.join(_CIMEROOT, "src", "drivers", "nuopc", "cime_config", "runseq")) - if (comp_ice == "cice" and comp_atm == 'datm' and comp_ocn == "docn"): - from runseq_D import gen_runseq - elif (comp_lnd == 'dlnd' and comp_glc == "cism"): - from runseq_TG import gen_runseq - elif (comp_atm == 'ufsatm' and comp_ocn == "mom" and comp_ice == 'cice'): - from runseq_NEMS import gen_runseq - else: - from runseq_general import gen_runseq + if (comp_ice == "cice" and comp_atm == 'datm' and comp_ocn == "docn"): + from runseq_D import gen_runseq + elif (comp_lnd == 'dlnd' and comp_glc == "cism"): + from runseq_TG import gen_runseq + elif (comp_atm == 'ufsatm' and comp_ocn == "mom" and comp_ice == 'cice'): + from runseq_NEMS import gen_runseq + else: + from runseq_general import gen_runseq - # create the run sequence - gen_runseq(case, coupling_times) + # create the run sequence + gen_runseq(case, coupling_times) ############################################################################### def compare_drv_flds_in(first, second, infile1, infile2): @@ -435,18 +409,6 @@ def _create_component_modelio_namelists(confdir, case, files): outfile.write(" {}{}{}".format("logfile = ", logfile,"\n")) outfile.write("::\n\n") - # also write out a driver log file - if model == 'cpl': - name = "DRV" - logfile = 'drv' + inst_string + ".log." + str(lid) - 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 diff --git a/cime_config/config_archive.xml b/cime_config/config_archive.xml index ff8bbf533..c87174125 100644 --- a/cime_config/config_archive.xml +++ b/cime_config/config_archive.xml @@ -4,7 +4,7 @@ hi?\d*.*\.nc$ unset - rpointer.cpl$NINST_STRING + rpointer$NINST_STRING.drv $CASE.cpl$NINST_STRING.r.$DATENAME.nc diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 372da834a..b93eaecaf 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -2095,15 +2095,15 @@ be computed based on PIO_NUMTASKS and number of compute tasks - $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 + + + + + + + + + @@ -2114,15 +2114,15 @@ env_run.xml pio rearranger choice box=1, subset=2 - 2 - 2 - 2 - 2 - 2 - 2 - 2 - 2 - 2 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 476b9f015..2e006204b 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -139,18 +139,18 @@ - - - - - - - - - - - - + + logical + expdef + DRIVER_attributes + + turns on bfb option in coupler which produce bfb results in the + coupler on different processor counts. (default: .false.) + + + $BFBFLAG + + real @@ -303,18 +303,6 @@ - - char - expdef - DRIVER_attributes - - Driver restart pointer file to initialize time info - - - rpointer.cpl - - - @@ -547,16 +535,6 @@ - - logical - nuopc - ALLCOMP_attributes - - true - - if true, mediator is present in run - - char expdef @@ -1162,6 +1140,29 @@ 0 + + char + expdef + MED_attributes + + Mediator restart pointer file. + + + rpointer.cpl + + + + + char + expdef + MED_attributes + + Full archive path to restart file for mediator + + + str_undefined + + integer @@ -1248,7 +1249,7 @@ logical history - MED_attributes + MED_history_attributes logical to write an extra initial coupler history file @@ -1257,344 +1258,344 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - char - expdef - ALLCOMP_attributes + + logical + history + MED_history_attributes - name of the coupling field with scalar information + writes atm fields in coupler average history files. + default: true - cpl_scalars + .true. - - integer - expdef - ALLCOMP_attributes + + logical + history + MED_history_attributes - total number of scalars in the scalar coupling field + writes lnd fields in coupler average history files. + default: true - 5 + .true. - - integer - expdef - ALLCOMP_attributes + + logical + history + MED_history_attributes - index of scalar containing global grid cell count in X dimension + writes ocn fields in coupler average history files. + default: true - 1 + .true. - - integer - expdef - ALLCOMP_attributes - + + 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 + + + 5 + + + + + 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 @@ -1630,7 +1631,7 @@ logical mapping - MED_attributes + FLDS_attributes used for atm->ocn and atm-ice mapping of u and v; rotate u,v to 3d cartesian space, map from src->dest, then rotate back .false. @@ -1641,7 +1642,7 @@ char mapping abs - MED_attributes + FLDS_attributes atm to ocn flux mapping file for fluxes $ATM2OCN_FMAPNAME @@ -1652,7 +1653,7 @@ char mapping abs - MED_attributes + FLDS_attributes atm to ocn state mapping file for states @@ -1665,7 +1666,7 @@ char mapping abs - MED_attributes + FLDS_attributes atm to ocn state mapping file for velocity @@ -1678,7 +1679,7 @@ char mapping abs - MED_attributes + FLDS_attributes ocn to atm mapping file for fluxes @@ -1691,7 +1692,7 @@ char mapping abs - MED_attributes + FLDS_attributes ocn to atm mapping file for states @@ -1704,7 +1705,7 @@ char mapping abs - MED_attributes + FLDS_attributes atm to ice flux mapping file for fluxes @@ -1717,7 +1718,7 @@ char mapping abs - MED_attributes + FLDS_attributes atm to ice state mapping file for states @@ -1730,7 +1731,7 @@ char mapping abs - MED_attributes + FLDS_attributes atm to ice state mapping file for velocity @@ -1743,7 +1744,7 @@ char mapping abs - MED_attributes + FLDS_attributes ice to atm mapping file for fluxes @@ -1756,7 +1757,7 @@ char mapping abs - MED_attributes + FLDS_attributes ice to atm mapping file for states @@ -1769,7 +1770,7 @@ char mapping abs - MED_attributes + FLDS_attributes atm to land mapping file for fluxes @@ -1782,7 +1783,7 @@ char mapping abs - MED_attributes + FLDS_attributes atm to land mapping file for states @@ -1795,7 +1796,7 @@ char mapping abs - MED_attributes + FLDS_attributes atm to land mapping file for states @@ -1808,7 +1809,7 @@ char mapping abs - MED_attributes + FLDS_attributes land to atm mapping file for fluxes @@ -1821,7 +1822,7 @@ char mapping abs - MED_attributes + FLDS_attributes land to atm mapping file for states @@ -1834,7 +1835,7 @@ char mapping abs - MED_attributes + FLDS_attributes lnd to runoff conservative mapping file @@ -1847,7 +1848,7 @@ char mapping abs - MED_attributes + FLDS_attributes runoff to lnd conservative mapping file @@ -1860,7 +1861,7 @@ char mapping abs - MED_attributes + FLDS_attributes runoff to lnd conservative mapping file @@ -1873,7 +1874,7 @@ char mapping abs - MED_attributes + FLDS_attributes runoff to ocn area overlap conservative mapping file @@ -1886,7 +1887,7 @@ char mapping abs - MED_attributes + FLDS_attributes glc2ocn runoff mapping file for liquid runoff @@ -1899,7 +1900,7 @@ char mapping abs - MED_attributes + FLDS_attributes glc to ice runoff conservative mapping file @@ -1912,7 +1913,7 @@ char mapping abs - MED_attributes + FLDS_attributes glc2ocn runoff mapping file for ice runoff @@ -1925,7 +1926,7 @@ char mapping abs - MED_attributes + FLDS_attributes runoff to ocn nearest neighbor plus smoothing conservative mapping file @@ -1938,7 +1939,7 @@ char mapping abs - MED_attributes + FLDS_attributes runoff to ocn nearest neighbor plus smoothing conservative mapping file @@ -1951,7 +1952,7 @@ char mapping abs - MED_attributes + FLDS_attributes land to glc mapping file for fluxes @@ -1964,7 +1965,7 @@ char mapping abs - MED_attributes + FLDS_attributes land to glc mapping file for states @@ -1977,7 +1978,7 @@ char mapping abs - MED_attributes + FLDS_attributes glc to land mapping file for fluxes @@ -1990,7 +1991,7 @@ char mapping abs - MED_attributes + FLDS_attributes glc to land mapping file for states @@ -2003,7 +2004,7 @@ char mapping abs - MED_attributes + FLDS_attributes atm to wav state mapping file for states @@ -2016,7 +2017,7 @@ char mapping abs - MED_attributes + FLDS_attributes atm to wav state mapping file for states @@ -2029,7 +2030,7 @@ char mapping abs - MED_attributes + FLDS_attributes ocn to wav state mapping file for states @@ -2042,7 +2043,7 @@ char mapping abs - MED_attributes + FLDS_attributes ice to wav state mapping file for states @@ -2055,7 +2056,7 @@ char mapping abs - MED_attributes + FLDS_attributes wav to ocn state mapping file for states @@ -2310,23 +2311,23 @@ - - - - - - - - - - - - - - - - - + + 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 @@ -2483,6 +2484,32 @@ + + 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 @@ -2552,58 +2579,58 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - + + 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 @@ -2695,136 +2722,136 @@ - - - - - - - - - - - - - - - - - - - - - - + + 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 + + @@ -3714,100 +3741,100 @@ - - - - - - - - - - - + + 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/testdefs/testlist_prealpha.xml b/cime_config/testdefs/testlist_prealpha.xml deleted file mode 100644 index 9af907ac0..000000000 --- a/cime_config/testdefs/testlist_prealpha.xml +++ /dev/null @@ -1,529 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/drivers/cime/ensemble_driver.F90 b/drivers/cime/ensemble_driver.F90 index 8ddbb727f..cee4450dd 100644 --- a/drivers/cime/ensemble_driver.F90 +++ b/drivers/cime/ensemble_driver.F90 @@ -1,16 +1,17 @@ module Ensemble_driver !----------------------------------------------------------------------------- - ! Code that creates the ensemble driver layer above the esm driver instance. + ! 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 shr_kind_mod , only : cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_log_mod , only : shrlogunit=> shr_log_unit - use shr_file_mod , only : shr_file_setLogUnit - use esm_utils_mod , only : mastertask, logunit, chkerr + use shr_kind_mod , only : cl=>shr_kind_cl + use med_utils_mod , only : chkerr => med_utils_ChkErr + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use med_internalstate_mod , only : mastertask + use med_internalstate_mod , only : logunit ! initialized here implicit none private @@ -18,11 +19,10 @@ module Ensemble_driver public :: SetServices private :: SetModelServices - character(*),parameter :: u_FILE_u = & - __FILE__ + character(*),parameter :: u_FILE_u = __FILE__ !================================================================================ -contains + contains !================================================================================ subroutine SetServices(ensemble_driver, rc) @@ -30,20 +30,23 @@ 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_GridCompSet - use ESMF , only : ESMF_Config, ESMF_ConfigCreate, ESMF_ConfigLoadFile + 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 + type(ESMF_Config) :: config + integer :: dbrc character(len=*), parameter :: subname = "(ensemble_driver.F90:SetServices)" !--------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + 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) @@ -64,7 +67,9 @@ subroutine SetServices(ensemble_driver, rc) call ESMF_GridCompSet(ensemble_driver, config=config, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + endif end subroutine SetServices @@ -72,17 +77,21 @@ 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 ESMF , only : ESMF_CalendarSetDefault - use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd - use NUOPC_Driver , only : NUOPC_DriverAddComp - use esm , only : ESMSetServices => SetServices, ReadAttributes - use esm_time_mod , only : esm_time_clockInit + 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 ESMF , only : ESMF_CalendarSetDefault + use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN + 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 esm_time_mod , only : esm_time_clockInit + 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 ! input/output variables type(ESMF_GridComp) :: ensemble_driver @@ -97,12 +106,15 @@ subroutine SetModelServices(ensemble_driver, rc) 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 - character(len=CS) :: read_restart_string + integer :: dbrc integer :: inst integer :: number_of_members integer :: ntasks_per_member @@ -119,15 +131,19 @@ subroutine SetModelServices(ensemble_driver, rc) !------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + 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 (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=localPet, PetCount=PetCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + !------------------------------------------- ! Initialize clocks !------------------------------------------- - call ReadAttributes(ensemble_driver, config, "ALLCOMP_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -148,6 +164,13 @@ subroutine SetModelServices(ensemble_driver, rc) return ! bail out end if + call ReadAttributes(ensemble_driver, config, "PELAYOUT_attributes::", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(ensemble_driver, name="cpl_rootpe", value=cvalue, rc=rc) + if (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 (chkerr(rc,__LINE__,u_FILE_u)) return @@ -160,68 +183,40 @@ subroutine SetModelServices(ensemble_driver, rc) return end if - if (trim(start_type) == trim(start_type_cont) .or. trim(start_type) == trim(start_type_brnch)) then - read_restart = .true. - else - read_restart = .false. - endif - write(read_restart_string,*) read_restart - - ! Add read_restart to ensemble_driver attributes - call NUOPC_CompAttributeAdd(ensemble_driver, attrList=(/'read_restart'/), rc=rc) + call InitRestart(ensemble_driver, read_restart, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(ensemble_driver, name='read_restart', value=trim(read_restart_string), rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="ninst", value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue, *) number_of_members !------------------------------------------- ! Extract the config object from the ensemble_driver !------------------------------------------- - - call ReadAttributes(ensemble_driver, config, "PELAYOUT_attributes::", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - !------------------------------------------- - ! Determine number of ensemble members and the number of tasks per member - !------------------------------------------- - - call NUOPC_CompAttributeGet(ensemble_driver, name="ninst", value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) number_of_members - - call ESMF_VMGet(vm, localPet=localPet, PetCount=PetCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - 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,")" + 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 - !------------------------------------------- - ! Loop over number of ensemblel members - !------------------------------------------- - allocate(petList(ntasks_per_member)) + call NUOPC_CompAttributeGet(ensemble_driver, name='cpl_rootpe', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue, *) rootpe_med + do inst=1,number_of_members - ! Determine pet list for driver instance petList(1) = (inst-1) * ntasks_per_member do n=2,ntasks_per_member petList(n) = petList(n-1) + 1 enddo - - ! Add driver instance to ensemble driver write(drvrinst,'(a,i4.4)') "ESM",inst call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=gridcomptmp, rc=rc) if (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 (chkerr(rc,__LINE__,u_FILE_u)) return @@ -231,47 +226,121 @@ subroutine SetModelServices(ensemble_driver, rc) else inst_suffix = '' endif - - ! Set the driver instance attributes + write(cvalue,*) read_restart call NUOPC_CompAttributeAdd(driver, attrList=(/'read_restart'/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(driver, name='read_restart', value=trim(read_restart_string), rc=rc) + call NUOPC_CompAttributeSet(driver, name='read_restart', value=trim(cvalue), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ReadAttributes(driver, config, "CLOCK_attributes::", rc=rc) + call ReadAttributes(driver, config, "MED_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ReadAttributes(driver, config, "DRIVER_attributes::", rc=rc) + call ReadAttributes(driver, config, "CLOCK_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ReadAttributes(driver, config, "DRV_modelio"//trim(inst_suffix)//"::", rc=rc) + call ReadAttributes(driver, config, "MED_modelio"//trim(inst_suffix)//"::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Set the driver log to the driver task 0 - if (mod(localPet, ntasks_per_member) == 0) then + ! 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 (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(driver, name="logfile", value=logfile, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - open (newunit=logunit,file=trim(diro)//"/"//trim(logfile)) + 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) - - ! Create a clock for each driver instance - call esm_time_clockInit(ensemble_driver, driver, logunit, mastertask, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif enddo + call esm_time_clockInit(ensemble_driver, driver, logunit, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return deallocate(petList) - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - end subroutine SetModelServices -end module Ensemble_driver + !================================================================================ + + 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 (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 (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 (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 (chkerr(rc,__LINE__,u_FILE_u)) return + + end subroutine InitRestart + +end module ENSEMBLE_DRIVER diff --git a/drivers/cime/esm.F90 b/drivers/cime/esm.F90 index 8955be093..f98af4038 100644 --- a/drivers/cime/esm.F90 +++ b/drivers/cime/esm.F90 @@ -4,14 +4,11 @@ module ESM ! Code that specializes generic ESM Component code. !----------------------------------------------------------------------------- - use shr_kind_mod , only : r8=>shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_log_mod , only : shrlogunit=> shr_log_unit - use shr_sys_mod , only : shr_sys_abort - use shr_mpi_mod , only : shr_mpi_bcast - use shr_mem_mod , only : shr_mem_init - use shr_file_mod , only : shr_file_setLogunit - use esm_utils_mod, only : logunit, mastertask, dbug_flag, chkerr - use perf_mod , only : t_initf + use ESMF , only : ESMF_Clock + use shr_kind_mod , only : r8=>shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs + use med_utils_mod , only : chkerr => med_utils_ChkErr + use med_utils_mod , only : med_memcheck + use med_internalstate_mod , only : logunit, loglevel, mastertask, med_id implicit none private @@ -22,6 +19,8 @@ module ESM private :: SetModelServices private :: SetRunSequence private :: ModifyCplLists + private :: IsRestart + private :: InitRestart private :: InitAttributes private :: CheckAttributes private :: AddAttributes @@ -104,18 +103,25 @@ 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 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_file_mod , only : shr_file_setLogunit, shr_file_getunit + 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_file_mod , only : shr_file_setLogunit, shr_file_getunit + use shr_log_mod , only : shrlogunit=> shr_log_unit ! input/output variables type(ESMF_GridComp) :: driver @@ -140,7 +146,6 @@ subroutine SetModelServices(driver, rc) !------------------------------------------- ! Set the io logunit to the value defined in ensemble_driver - ! TODO: - is this statement still correct? ! it may be corrected below if the med mastertask is not the driver mastertask !------------------------------------------- call shr_file_setLogunit(logunit) @@ -155,14 +160,6 @@ subroutine SetModelServices(driver, rc) call ESMF_VMGet(vm, localPet=localPet, mpiCommunicator=global_comm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=localPet, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (localPet == 0) then - mastertask=.true. - else - mastertask = .false. - end if - !------------------------------------------- ! determine the generic component labels !------------------------------------------- @@ -183,6 +180,9 @@ subroutine SetModelServices(driver, rc) call ReadAttributes(driver, config, "DRIVER_attributes::", formatprint=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call ReadAttributes(driver, config, "FLDS_attributes::", formatprint=.true., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ReadAttributes(driver, config, "CLOCK_attributes::", formatprint=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -199,7 +199,7 @@ subroutine SetModelServices(driver, rc) ! Initialize other attributes (after initializing driver clock) !------------------------------------------- - call InitAttributes(driver, rc) + call InitAttributes(driver, mastertask, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return !------------------------------------------- @@ -209,9 +209,11 @@ subroutine SetModelServices(driver, rc) call esm_init_pelayout(driver, maxthreads, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Memory test + ! Print out present flags to mediator log file if (mastertask) then + ! Memory test call shr_mem_init(strbuf=meminitstr) + write(logunit,*) trim(meminitstr) end if @@ -219,7 +221,15 @@ subroutine SetModelServices(driver, rc) ! Timer initialization (has to be after pelayouts are determined) !------------------------------------------- - call t_initf('drv_in', LogPrint=.true., mpicom=global_comm, mastertask=mastertask, MaxThreads=maxthreads) + call t_initf('drv_in', LogPrint=.true., mpicom=global_comm, & + mastertask=mastertask, MaxThreads=maxthreads) + + !------------------------------------------- + ! Perform restarts if appropriate + !------------------------------------------- + + call InitRestart(driver, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -229,14 +239,14 @@ end subroutine SetModelServices subroutine SetRunSequence(driver, rc) - use ESMF , only : ESMF_GridComp, ESMF_LogWrite, ESMF_SUCCESS, ESMF_LOGMSG_INFO - use ESMF , only : 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 + use ESMF , only : ESMF_GridComp, ESMF_LogWrite, ESMF_SUCCESS, ESMF_LOGMSG_INFO + use ESMF , only : 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 @@ -302,6 +312,7 @@ subroutine pretty_print_nuopc_freeformat(ffstuff, label, rc) ! local variables integer :: i integer :: linecnt + integer :: dbug_flag = 5 character(len=NUOPC_FreeFormatLen), pointer :: outstr(:) !--------------------------------------- @@ -397,8 +408,103 @@ end subroutine ModifyCplLists !================================================================================ - subroutine InitAttributes(driver, rc) + 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=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 :: 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 (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 + logical :: read_restart ! read the restart file, based on start_type + character(len=CL) :: cvalue ! temporary + character(len=CL) :: rest_case_name ! Short case identification + character(len=*) , parameter :: subname = "(esm.F90:InitRestart)" + !------------------------------------------- + + rc = ESMF_SUCCESS + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + + !----------------------------------------------------- + ! Carry out restart if appropriate + !----------------------------------------------------- + + read_restart = IsRestart(driver, rc) + if (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 (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 (chkerr(rc,__LINE__,u_FILE_u)) return + + write(cvalue,*) read_restart + call NUOPC_CompAttributeSet(driver, name='read_restart', value=trim(cvalue), rc=rc) + if (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 @@ -418,6 +524,7 @@ subroutine InitAttributes(driver, rc) ! input/output variables type(ESMF_GridComp) , intent(inout) :: driver + logical , intent(in) :: mastertask ! mediator mastertask integer , intent(out) :: rc ! return code ! local variables @@ -452,10 +559,10 @@ subroutine InitAttributes(driver, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + call med_memcheck(subname, 0, mastertask) !---------------------------------------------------------- ! Initialize options for reproducible sums - ! TODO: this needs to be moved out of here !---------------------------------------------------------- call NUOPC_CompAttributeGet(driver, name="reprosum_use_ddpdd", value=cvalue, rc=rc) @@ -475,7 +582,6 @@ subroutine InitAttributes(driver, rc) !---------------------------------------------------------- ! Initialize freezing point calculation for all components - ! TODO: this needs to be moved out of here !---------------------------------------------------------- call NUOPC_CompAttributeGet(driver, name="tfreeze_option", value=tfreeze_option, rc=rc) @@ -596,6 +702,7 @@ 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 @@ -606,6 +713,7 @@ subroutine CheckAttributes( driver, rc ) !----- local ----- character(len=CL) :: cvalue ! temporary character(len=CL) :: start_type ! Type of startup + character(len=CL) :: rest_case_name ! Short case identification character(len=CS) :: logFilePostFix ! postfix for output log files character(len=CL) :: outPathRoot ! root for output log files character(len=CS) :: cime_model @@ -640,6 +748,15 @@ subroutine CheckAttributes( driver, rc ) 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 (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 !=============================================================================== @@ -666,7 +783,7 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, r integer :: stat integer :: inst_index character(len=CL) :: cvalue - character(len=CS) :: attribute + character(len=32), allocatable :: attrList(:) integer :: componentCount character(len=*), parameter :: subname = "(esm.F90:AddAttributes)" logical :: lvalue = .false. @@ -685,20 +802,32 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, r if (chkerr(rc,__LINE__,u_FILE_u)) return !------ - ! Add restart flag a to gcomp attributes + ! Add all the other attributes in AttrList (which have already been added to driver attributes) !------ - attribute = 'read_restart' - call NUOPC_CompAttributeAdd(gcomp, (/trim(attribute)/), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(driver, name="mediator_read_restart", value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) lvalue - if (.not. lvalue) then - call NUOPC_CompAttributeGet(driver, name=trim(attribute), value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - call NUOPC_CompAttributeSet(gcomp, name=trim(attribute), value=trim(cvalue), rc=rc) + allocate(attrList(1)) + attrList = (/"read_restart"/) + + call NUOPC_CompAttributeAdd(gcomp, attrList=attrList, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(attrList) + if (trim(attrList(n)) == "read_restart") then + call NUOPC_CompAttributeGet(driver, name="mediator_read_restart", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) lvalue + if (.not. lvalue) then + call NUOPC_CompAttributeGet(driver, name=trim(attrList(n)), value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + call NUOPC_CompAttributeSet(gcomp, name=trim(attrList(n)), value=trim(cvalue), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call NUOPC_CompAttributeGet(driver, name=trim(attrList(n)), value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name=trim(attrList(n)), value=trim(cvalue), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + enddo + deallocate(attrList) !------ ! Add component specific attributes @@ -716,10 +845,13 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, r if (chkerr(rc,__LINE__,u_FILE_u)) return !------ - ! Add mediator specific attributes - if component is mediator + ! Add mediator specific attributes !------ if (compname == 'MED') then - call ReadAttributes(gcomp, config, "MED_attributes::", rc=rc) + call ReadAttributes(gcomp, config, "MED_history_attributes::", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ReadAttributes(gcomp, config, "FLDS_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif @@ -823,21 +955,18 @@ 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, ESMF_UtilStringLowerCase - use NUOPC , only : NUOPC_CompAttributeGet - use NUOPC_Driver , only : NUOPC_DriverAddComp - use mpi , only : MPI_COMM_NULL - use mct_mod , only : mct_world_init - use shr_pio_mod , only : shr_pio_init2 - -#ifdef MED_PRESENT - use med_internalstate_mod , only : med_id + 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, ESMF_UtilStringLowerCase + use NUOPC , only : NUOPC_CompAttributeGet + use NUOPC_Driver , only : NUOPC_DriverAddComp + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag, CS, CL + use mpi , only : MPI_COMM_NULL + use mct_mod , only : mct_world_init + use shr_pio_mod , only : shr_pio_init2 use med , only : MedSetServices => SetServices -#endif #ifdef ATM_PRESENT use atm_comp_nuopc , only : ATMSetServices => SetServices #endif @@ -887,7 +1016,6 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) logical, allocatable :: comp_iamin(:) character(len=5) :: inst_suffix character(CL) :: cvalue - logical :: found_comp character(len=*), parameter :: subname = "(esm_pelayout.F90:esm_init_pelayout)" !--------------------------------------- @@ -970,8 +1098,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) if (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 + 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 @@ -991,72 +1118,51 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) comps(i+1) = i+1 - found_comp = .false. -#ifdef MED_PRESENT if (trim(compLabels(i)) == 'MED') then med_id = i + 1 call NUOPC_DriverAddComp(driver, trim(compLabels(i)), MEDSetServices, petList=petlist, comp=child, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - found_comp = .true. - end if -#endif #ifdef ATM_PRESENT - if (trim(compLabels(i)) .eq. 'ATM') then + elseif(trim(compLabels(i)) .eq. 'ATM') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ATMSetServices, petList=petlist, comp=child, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - found_comp = .true. - end if #endif #ifdef LND_PRESENT - if (trim(compLabels(i)) .eq. 'LND') then + elseif(trim(compLabels(i)) .eq. 'LND') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), LNDSetServices, PetList=petlist, comp=child, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - found_comp = .true. - end if #endif #ifdef OCN_PRESENT - if (trim(compLabels(i)) .eq. 'OCN') then + elseif(trim(compLabels(i)) .eq. 'OCN') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), OCNSetServices, PetList=petlist, comp=child, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - found_comp = .true. - end if #endif #ifdef ICE_PRESENT - if (trim(compLabels(i)) .eq. 'ICE') then + elseif(trim(compLabels(i)) .eq. 'ICE') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ICESetServices, PetList=petlist, comp=child, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - found_comp = .true. - end if #endif #ifdef GLC_PRESENT - if (trim(compLabels(i)) .eq. 'GLC') then + elseif(trim(compLabels(i)) .eq. 'GLC') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), GLCSetServices, PetList=petlist, comp=child, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - found_comp = .true. - end if #endif #ifdef ROF_PRESENT - if (trim(compLabels(i)) .eq. 'ROF') then + elseif(trim(compLabels(i)) .eq. 'ROF') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ROFSetServices, PetList=petlist, comp=child, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - found_comp = .true. - end if #endif #ifdef WAV_PRESENT - if (trim(compLabels(i)) .eq. 'WAV') then + elseif(trim(compLabels(i)) .eq. 'WAV') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), WAVSetServices, PetList=petlist, comp=child, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - found_comp = .true. - end if #endif #ifdef ESP_PRESENT - if (trim(compLabels(i)) .eq. 'ESP') then + elseif(trim(compLabels(i)) .eq. 'ESP') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ESPSetServices, PetList=petlist, comp=child, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - found_comp = .true. - end if #endif - if (.not. found_comp) then + else write(msgstr,*) 'No component ',trim(compLabels(i)),' found' call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return @@ -1077,9 +1183,17 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) ! 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 (chkerr(rc,__LINE__,u_FILE_u)) return + ! call ESMF_GridCompSetVMMaxPEs(child, maxPeCountPerPet=nthrds, rc=rc) + ! if (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 (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MethodAdd(child, label="GetRestartFileToRead", & + userRoutine=GetRestartFileToRead, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return comp_iamin(i) = .true. else comms(i+1) = MPI_COMM_NULL @@ -1101,10 +1215,10 @@ 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 perf_mod , only : t_prf, t_finalizef + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_VM, ESMF_VMGet + use ESMF , only : ESMF_SUCCESS + use NUOPC , only : NUOPC_CompAttributeGet + use perf_mod , only : t_prf, t_finalizef ! input/output variables type(ESMF_GridComp) :: driver @@ -1120,10 +1234,6 @@ subroutine esm_finalize(driver, rc) rc = ESMF_SUCCESS - if (mastertask) then - write(logunit,*)' SUCCESSFUL TERMINATION OF CESM' - end if - call ESMF_GridCompGet(driver, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, mpiCommunicator=mpicomm, rc=rc) @@ -1146,4 +1256,163 @@ subroutine esm_finalize(driver, rc) 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 (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 (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 (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(nextTime, yy=year, mm=month, dd=day, s=seconds, rc=rc) + if (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 (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=localPet, rc=rc) + if (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 + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + + is_restart = IsRestart(gcomp, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (is_restart) then + restartname = "" + + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=localPet, rc=rc) + if (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 (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 (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/drivers/cime/esm_time_mod.F90 b/drivers/cime/esm_time_mod.F90 index 3554394d7..8a4619165 100644 --- a/drivers/cime/esm_time_mod.F90 +++ b/drivers/cime/esm_time_mod.F90 @@ -16,7 +16,8 @@ module esm_time_mod use ESMF , only : operator(-), operator(*) , operator(>=) use ESMF , only : operator(<=), operator(>), operator(==) use NUOPC , only : NUOPC_CompAttributeGet - use esm_utils_mod , only : chkerr + use med_utils_mod , only : chkerr => med_utils_ChkErr + use med_time_mod , only : med_time_alarmInit implicit none private ! default private @@ -24,7 +25,6 @@ module esm_time_mod public :: esm_time_clockInit ! initialize driver clock (assumes default calendar) private :: esm_time_timeInit - private :: esm_time_alarmInit private :: esm_time_date2ymd ! Clock and alarm options @@ -52,12 +52,11 @@ module esm_time_mod contains !=============================================================================== - subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastertask, rc) + subroutine esm_time_clockInit(ensemble_driver, esmdriver, logunit, rc) ! input/output variables - type(ESMF_GridComp) :: ensemble_driver, instance_driver + type(ESMF_GridComp) :: ensemble_driver, esmdriver integer, intent(in) :: logunit - logical, intent(in) :: mastertask integer, intent(out) :: rc ! local variables @@ -67,6 +66,8 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert 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_Alarm) :: alarm_stop ! alarm @@ -96,56 +97,67 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert integer :: dtime_drv ! time-step to use integer :: yr, mon, day, sec ! Year, month, day, secs 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) :: inst_suffix - integer :: tmp(4) ! Array for Broadcast + integer :: tmp(6) ! Array for Broadcast logical :: isPresent character(len=*), parameter :: subname = '(esm_time_clockInit): ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_GridCompGet(instance_driver, vm=vm, rc=rc) + call ESMF_GridCompGet(esmdriver, vm=vm, rc=rc) if (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 (ChkErr(rc,__LINE__,u_FILE_u)) return + + mastertask = localPet == 0 !--------------------------------------------------------------------------- ! Determine start time, reference time and current time !--------------------------------------------------------------------------- - call NUOPC_CompAttributeGet(instance_driver, name="start_ymd", value=cvalue, rc=rc) + curr_ymd = 0 + curr_tod = 0 + + call NUOPC_CompAttributeGet(esmdriver, name="start_ymd", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) start_ymd - call NUOPC_CompAttributeGet(instance_driver, name="start_tod", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(esmdriver, name="start_tod", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) start_tod - call NUOPC_CompAttributeGet(instance_driver, name='read_restart', value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(esmdriver, name="ref_ymd", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ref_ymd + call NUOPC_CompAttributeGet(esmdriver, name="ref_tod", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ref_tod + + call NUOPC_CompAttributeGet(esmdriver, name='read_restart', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) read_restart if (read_restart) then - - call NUOPC_CompAttributeGet(instance_driver, name='drv_restart_pointer', value=restart_file, rc=rc) + call NUOPC_CompAttributeGet(esmdriver, name='restart_file', value=restart_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(6,*)'DEBUG: restart_file = ',trim(restart_file) - - if (trim(restart_file) /= 'none') then - - call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", isPresent=isPresent, rc=rc) + !--- read rpointer if restart_file is set to str_undefined --- + if (trim(restart_file) == 'str_undefined') then + call NUOPC_CompAttributeGet(esmdriver, name="inst_suffix", isPresent=isPresent, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if(isPresent) then - call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", value=inst_suffix, rc=rc) + call NUOPC_CompAttributeGet(esmdriver, name="inst_suffix", value=inst_suffix, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else inst_suffix = "" endif - - restart_pfile = trim(restart_file)//inst_suffix - write(6,*)'DEBUG: restart_pfile = ',restart_pfile - + restart_pfile = "rpointer.cpl"//inst_suffix if (mastertask) then call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), & ESMF_LOGMSG_INFO) @@ -166,39 +178,37 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert close(unitn) call ESMF_LogWrite(trim(subname)//" read driver restart from file = "//trim(restart_file), & ESMF_LOGMSG_INFO) - - call esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - write(6,*)'DEBUG: curr_ymd = ',curr_ymd - write(6,*)'DEBUG: curr_tod = ',curr_tod - tmp(1) = start_ymd ; tmp(2) = start_tod - tmp(3) = curr_ymd ; tmp(4) = curr_tod endif - - call ESMF_VMBroadcast(vm, tmp, 4, 0, rc=rc) + endif + if (mastertask) then + call esm_time_read_restart(restart_file, & + start_ymd, start_tod, ref_ymd, ref_tod, curr_ymd, curr_tod, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - start_ymd = tmp(1) ; start_tod = tmp(2) - curr_ymd = tmp(3) ; curr_tod = tmp(4) - - else - - if (mastertask) then - write(logunit,*) ' NOTE: the current compset has no mediator - which provides the clock restart information' - write(logunit,*) ' In this case the restarts are handled solely by the component being used and' - write(logunit,*) ' and the driver clock will always be starting from the initial date on restart' - end if - curr_ymd = start_ymd - curr_tod = start_tod - - end if - - else - + 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 (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 - - end if ! end if read_restart + endif ! Determine start time (THE FOLLOWING ASSUMES THAT THE DEFAULT CALENDAR IS SET in the driver) @@ -215,6 +225,20 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert write(logunit,*) trim(subname)//': driver start_tod: '// trim(tmpstr) endif + ! Determine reference time + call esm_time_date2ymd(ref_ymd, yr, mon, day) + call ESMF_TimeSet( RefTime, yy=yr, mm=mon, dd=day, s=ref_tod, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if(mastertask) then + write(tmpstr,'(i10)') ref_ymd + call ESMF_LogWrite(trim(subname)//': driver ref_ymd: '// trim(tmpstr), ESMF_LOGMSG_INFO) + 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) + write(logunit,*) trim(subname)//': driver ref_tod: '// trim(tmpstr) + endif + ! Determine current time call esm_time_date2ymd(curr_ymd, yr, mon, day) call ESMF_TimeSet( CurrTime, yy=yr, mm=mon, dd=day, s=curr_tod, rc=rc) @@ -229,46 +253,39 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert write(logunit,*) trim(subname)//': driver curr_tod: '// trim(tmpstr) endif - ! Set reference time - HARD-CODED TO START TIME - ref_ymd = start_ymd - ref_tod = start_tod - call esm_time_date2ymd(ref_ymd, yr, mon, day) - call ESMF_TimeSet( RefTime, yy=yr, mm=mon, dd=day, s=ref_tod, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - !--------------------------------------------------------------------------- ! Determine driver clock timestep !--------------------------------------------------------------------------- - call NUOPC_CompAttributeGet(instance_driver, name="atm_cpl_dt", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(esmdriver, name="atm_cpl_dt", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) atm_cpl_dt - call NUOPC_CompAttributeGet(instance_driver, name="lnd_cpl_dt", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(esmdriver, name="lnd_cpl_dt", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) lnd_cpl_dt - call NUOPC_CompAttributeGet(instance_driver, name="ice_cpl_dt", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(esmdriver, name="ice_cpl_dt", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) ice_cpl_dt - call NUOPC_CompAttributeGet(instance_driver, name="ocn_cpl_dt", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(esmdriver, name="ocn_cpl_dt", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) ocn_cpl_dt - call NUOPC_CompAttributeGet(instance_driver, name="glc_cpl_dt", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(esmdriver, name="glc_cpl_dt", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) glc_cpl_dt - call NUOPC_CompAttributeGet(instance_driver, name="rof_cpl_dt", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(esmdriver, name="rof_cpl_dt", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) rof_cpl_dt - call NUOPC_CompAttributeGet(instance_driver, name="wav_cpl_dt", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(esmdriver, name="wav_cpl_dt", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) wav_cpl_dt - call NUOPC_CompAttributeGet(instance_driver, name="glc_avg_period", value=glc_avg_period, rc=rc) + call NUOPC_CompAttributeGet(esmdriver, name="glc_avg_period", value=glc_avg_period, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) glc_avg_period @@ -282,7 +299,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------------------------------------------- - ! Create an instance_driver clock + ! Create the driver clock with an artificial stop time !--------------------------------------------------------------------------- ! Create the clock @@ -299,20 +316,20 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert if (ChkErr(rc,__LINE__,u_FILE_u)) return end do - ! Set the ensemble driver gridded component clock to the created clock - call ESMF_GridCompSet(instance_driver, clock=clock, rc=rc) + ! Set the driver gridded component clock to the created clock + call ESMF_GridCompSet(esmdriver, clock=clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Set driver clock stop time - call NUOPC_CompAttributeGet(instance_driver, name="stop_option", value=stop_option, rc=rc) + call NUOPC_CompAttributeGet(esmdriver, name="stop_option", value=stop_option, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(instance_driver, name="stop_n", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(esmdriver, name="stop_n", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_n - call NUOPC_CompAttributeGet(instance_driver, name="stop_ymd", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(esmdriver, name="stop_ymd", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_ymd - call NUOPC_CompAttributeGet(instance_driver, name="stop_tod", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(esmdriver, name="stop_tod", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_tod if ( stop_ymd < 0) then @@ -329,7 +346,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert write(logunit,*) trim(subname)//': driver stop_tod: '// trim(tmpstr) endif - call esm_time_alarmInit(clock, & + call med_time_alarmInit(clock, & alarm = alarm_stop, & option = stop_option, & opt_n = stop_n, & @@ -347,14 +364,12 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert !--------------------------------------------------------------------------- ! Create the ensemble driver clock - ! TODO: this is done repeatedly - but only needs to be done the first time this is called !--------------------------------------------------------------------------- TimeStep = StopTime - ClockTime clock = ESMF_ClockCreate(TimeStep, ClockTime, StopTime=StopTime, & refTime=RefTime, name='ESMF ensemble Driver Clock', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridCompSet(ensemble_driver, clock=clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -362,202 +377,6 @@ end subroutine esm_time_clockInit !=============================================================================== - subroutine esm_time_alarmInit( clock, alarm, option, & - opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) - - ! 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 = '(med_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 (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! initial guess of next alarm, this will be updated below - if (present(RefTime)) then - NextAlarm = RefTime - else - NextAlarm = CurrTime - endif - - ! Get calendar from clock - call ESMF_ClockGet(clock, calendar=cal) - - ! Error checks - if (trim(option) == optdate) then - if (.not. present(opt_ymd)) then - call ESMF_LogWrite(trim(subname)//trim(option)//' requires opt_ymd', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - if (lymd < 0 .or. ltod < 0) then - call ESMF_LogWrite(subname//trim(option)//'opt_ymd, opt_tod invalid', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - else if (trim(option) == optNSteps .or. & - trim(option) == optNSeconds .or. & - trim(option) == optNMinutes .or. & - trim(option) == optNHours .or. & - trim(option) == optNDays .or. & - trim(option) == optNMonths .or. & - trim(option) == optNYears) then - if (.not.present(opt_n)) then - call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - if (opt_n <= 0) then - call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - end if - end if - - ! Determine inputs for call to create alarm - selectcase (trim(option)) - - case (optNONE) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optNever) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optNSteps) - call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNSeconds) - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMinutes) - call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNHours) - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNDays) - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMonths) - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optMonthly) - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - - case (optNYears) - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optYearly) - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - - case default - call ESMF_LogWrite(subname//'unknown option '//trim(option), ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - - end select - - ! -------------------------------------------------------------------------------- - ! --- AlarmInterval and NextAlarm should be set --- - ! -------------------------------------------------------------------------------- - - ! --- advance Next Alarm so it won't ring on first timestep for - ! --- most options above. go back one alarminterval just to be careful - - if (update_nextalarm) then - NextAlarm = NextAlarm - AlarmInterval - do while (NextAlarm <= CurrTime) - NextAlarm = NextAlarm + AlarmInterval - enddo - endif - - alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & - ringInterval=AlarmInterval, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - end subroutine esm_time_alarmInit - - !=============================================================================== - subroutine esm_time_timeInit( Time, ymd, cal, tod, desc, logunit ) ! Create the ESMF_Time object corresponding to the given input time, given in @@ -627,7 +446,8 @@ end subroutine esm_time_date2ymd !=============================================================================== - subroutine esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) + subroutine esm_time_read_restart(restart_file, & + start_ymd, start_tod, ref_ymd, ref_tod, curr_ymd, curr_tod, rc) use netcdf , only : nf90_open, nf90_nowrite, nf90_noerr use netcdf , only : nf90_inq_varid, nf90_get_var, nf90_close @@ -635,6 +455,8 @@ subroutine esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, c ! input/output variables 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) @@ -655,7 +477,6 @@ subroutine esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, c rc = ESMF_FAILURE return endif - status = nf90_inq_varid(ncid, 'start_ymd', varid) if (status /= nf90_NoErr) then call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid start_ymd', ESMF_LOGMSG_INFO) @@ -668,7 +489,6 @@ subroutine esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, c rc = ESMF_FAILURE return end if - status = nf90_inq_varid(ncid, 'start_tod', varid) if (status /= nf90_NoErr) then call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid start_tod', ESMF_LOGMSG_INFO) @@ -681,7 +501,30 @@ subroutine esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, c rc = ESMF_FAILURE return end if - + status = nf90_inq_varid(ncid, 'ref_ymd', varid) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid ref_ymd', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_get_var(ncid, varid, ref_ymd) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var ref_ymd', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_inq_varid(ncid, 'ref_tod', varid) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid ref_tod', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_get_var(ncid, varid, ref_tod) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var ref_tod', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if status = nf90_inq_varid(ncid, 'curr_ymd', varid) if (status /= nf90_NoErr) then call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid curr_ymd', ESMF_LOGMSG_INFO) @@ -694,7 +537,6 @@ subroutine esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, c rc = ESMF_FAILURE return end if - status = nf90_inq_varid(ncid, 'curr_tod', varid) if (status /= nf90_NoErr) then call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid curr_tod', ESMF_LOGMSG_INFO) @@ -707,7 +549,6 @@ subroutine esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, c rc = ESMF_FAILURE return end if - status = nf90_close(ncid) if (status /= nf90_NoErr) then call ESMF_LogWrite(trim(subname)//' ERROR: nf90_close', ESMF_LOGMSG_INFO) @@ -717,13 +558,14 @@ subroutine esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, c write(tmpstr,*) trim(subname)//" read start_ymd = ",start_ymd call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - write(tmpstr,*) trim(subname)//" read start_tod = ",start_tod call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - + write(tmpstr,*) trim(subname)//" read ref_ymd = ",ref_ymd + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + write(tmpstr,*) trim(subname)//" read ref_tod = ",ref_tod + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) write(tmpstr,*) trim(subname)//" read curr_ymd = ",curr_ymd call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - write(tmpstr,*) trim(subname)//" read curr_tod = ",curr_tod call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) diff --git a/drivers/cime/esm_utils_mod.F90 b/drivers/cime/esm_utils_mod.F90 deleted file mode 100644 index cb5dc4360..000000000 --- a/drivers/cime/esm_utils_mod.F90 +++ /dev/null @@ -1,55 +0,0 @@ -module esm_utils_mod - - implicit none - public - - logical :: mastertask - integer :: logunit - integer :: dbug_flag = 0 - - character(*), parameter :: u_FILE_u = & - __FILE__ - -!=============================================================================== -contains -!=============================================================================== - - logical function ChkErr(rc, line, file, mpierr) -#ifdef USE_MPI2 - use mpi, only : MPI_ERROR_STRING, MPI_MAX_ERROR_STRING, MPI_SUCCESS -#else - use mpi, only : MPI_SUCCESS -#endif - 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 -#ifndef USE_MPI2 - integer, parameter :: MPI_MAX_ERROR_STRING=80 -#endif - character(MPI_MAX_ERROR_STRING) :: lstring - integer :: dbrc, lrc, len, ierr - - ChkErr = .false. - lrc = rc - if (present(mpierr) .and. mpierr) then - if (rc == MPI_SUCCESS) return -#ifdef USE_MPI2 - call MPI_ERROR_STRING(rc, lstring, len, ierr) -#else - write(lstring,*) "ERROR in mct mpi-serial library rc=",rc -#endif - call ESMF_LogWrite("ERROR: "//trim(lstring), ESMF_LOGMSG_INFO, line=line, file=file, rc=dbrc) - lrc = ESMF_FAILURE - endif - - if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then - ChkErr = .true. - endif - end function ChkErr - -end module esm_utils_mod diff --git a/mediator/Makefile b/mediator/Makefile index 97d2e8048..b9dcce362 100644 --- a/mediator/Makefile +++ b/mediator/Makefile @@ -53,7 +53,7 @@ med_phases_prep_lnd_mod.o : med_kind_mod.o med_internalstate_mod.o med_map_mod.o med_phases_prep_ocn_mod.o : med_kind_mod.o med_internalstate_mod.o med_constants_mod.o med_map_mod.o med_merge_mod.o med_methods_mod.o esmFlds.o med_utils_mod.o med_phases_prep_rof_mod.o : med_kind_mod.o med_internalstate_mod.o med_map_mod.o med_constants_mod.o med_merge_mod.o med_methods_mod.o esmFlds.o med_utils_mod.o med_phases_prep_wav_mod.o : med_kind_mod.o med_utils_mod.o med_internalstate_mod.o med_constants_mod.o med_map_mod.o med_methods_mod.o med_merge_mod.o esmFlds.o -med_phases_profile_mod.o : med_kind_mod.o med_utils_mod.o med_constants_mod.o med_internalstate_mod.o med_time_mod.o -med_phases_restart_mod.o : med_kind_mod.o med_utils_mod.o med_constants_mod.o med_internalstate_mod.o esmFlds.o med_io_mod.o +med_phases_profile_mod.o : med_kind_mod.o med_utils_mod.o med_constants_mod.o med_internalstate_mod.o +med_phases_restart_mod.o : med_kind_mod.o med_utils_mod.o med_constants_mod.o med_internalstate_mod.o esmFlds.o med_io_mod.o med_time_mod.o : med_kind_mod.o med_utils_mod.o med_constants_mod.o med_utils_mod.o : med_kind_mod.o med_utils_mod.F90 diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index f93a60a73..5f755985a 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -37,7 +37,7 @@ module esmflds integer , public, parameter :: mapnstod_consf = 8 ! nearest source to destination followed by conservative frac integer , public, parameter :: nmappers = 8 - character(len=*) , public, parameter :: mapnames(nmappers) = & + character(len=*) , public, parameter :: mapnames(nmappers) = & (/'bilnr ','consf ','consd ','patch ','fcopy ','nstod ','nstod_consd','nstod_consf'/) logical, public :: mapuv_with_cart3d ! rotate u,v to 3d cartesian space, map from src->dest, then rotate back @@ -102,8 +102,8 @@ module esmflds type (med_fldList_type), public :: fldListTo(ncomps) ! advertise fields to components type (med_fldList_type), public :: fldListFr(ncomps) ! advertise fields from components - type (med_fldList_type), public :: fldListMed_aoflux - type (med_fldList_type), public :: fldListMed_ocnalb + type (med_fldList_type), public :: fldListMed_aoflux + type (med_fldList_type), public :: fldListMed_ocnalb integer :: dbrc character(len=CL) :: infostr @@ -206,7 +206,7 @@ subroutine med_fldList_AddMrg(flds, fldname, & ! ---------------------------------------------- use ESMF, only : ESMF_FAILURE, ESMF_LogWrite - use ESMF, only : ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR + use ESMF, only : ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR ! input/output variables type(med_fldList_entry_type) , pointer :: flds(:) @@ -293,18 +293,19 @@ subroutine med_fldList_AddMap(flds, fldname, destcomp, maptype, mapnorm, mapfile ! intput/output variables type(med_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=*), optional , intent(in) :: mapfile + character(len=*) , intent(in) :: fldname + integer , intent(in) :: destcomp + integer , intent(in) :: maptype + character(len=*) , intent(in) :: mapnorm + character(len=*), optional , intent(in) :: mapfile ! local variables - integer :: id, n - integer :: rc - character(len=CX) :: lmapfile + integer :: id, n + integer :: rc + character(CX) :: lmapfile character(len=*),parameter :: subname='(med_fldList_AddMap)' ! ---------------------------------------------- + lmapfile = 'unset' if (present(mapfile)) lmapfile = mapfile @@ -357,10 +358,7 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num 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 -#if ESMF_VERSION_MINOR > 0 - use ESMF , only : ESMF_STATEINTENT_IMPORT, ESMF_STATEINTENT_EXPORT, ESMF_StateIntent_Flag - use ESMF , only : ESMF_RC_ARG_BAD, ESMF_LogSetError, operator(==) -#endif + ! input/output variables type(ESMF_State) , intent(inout) :: state type(med_fldlist_type), intent(in) :: fldList @@ -377,10 +375,6 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num type(ESMF_Field) :: field character(CS) :: shortname character(CS) :: stdname -#if ESMF_VERSION_MINOR > 0 - type(ESMF_StateIntent_Flag) :: stateIntent - character(ESMF_MAXSTR) :: transferActionAttr -#endif character(ESMF_MAXSTR) :: transferAction character(ESMF_MAXSTR), pointer :: StandardNameList(:) character(ESMF_MAXSTR), pointer :: ConnectedList(:) @@ -444,21 +438,6 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num #endif nflds = size(fldList%flds) -#if ESMF_VERSION_MINOR > 0 - call ESMF_StateGet(state, stateIntent=stateIntent, rc=rc) - if (stateIntent==ESMF_STATEINTENT_EXPORT) then - transferActionAttr="ProducerTransferAction" - elseif (stateIntent==ESMF_STATEINTENT_IMPORT) then - transferActionAttr="ConsumerTransferAction" - else - call ESMF_LogSetError(ESMF_RC_ARG_BAD, & - msg="The stateIntent must either be IMPORT or EXPORT here.", & - line=__LINE__, & - file=__FILE__, & - rcToReturn=rc) - return ! bail out - endif -#endif do n = 1, nflds shortname = fldList%flds(n)%shortname @@ -468,12 +447,8 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num 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 -#if ESMF_VERSION_MINOR > 0 - call NUOPC_GetAttribute(field, name=TransferActionAttr, value=transferAction, rc=rc) -#else - call NUOPC_GetAttribute(field, name="TransferActionGeomObject", value=transferAction, rc=rc) -#endif + 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 @@ -682,7 +657,7 @@ subroutine med_fldList_Document_Mapping(logunit, med_coupling_active) ! input/output variables integer, intent(in) :: logunit - logical, intent(in) :: med_coupling_active(:,:) + logical, intent(in) :: med_coupling_active(:,:) ! local variables integer :: nsrc,ndst,nf,nm,n @@ -703,7 +678,7 @@ subroutine med_fldList_Document_Mapping(logunit, med_coupling_active) !----------------------------------------------------------- !--------------------------------------- - ! Document mapping (also add albedo and aoflux) + ! Document mapping (also add albedo and aoflux) !--------------------------------------- ! Loop over src components @@ -776,12 +751,12 @@ end subroutine med_fldList_Document_Mapping subroutine med_fldList_Document_Merging(logunit, med_coupling_active) !--------------------------------------- - ! Document merging to target destination fields + ! Document merging to target destination fields !--------------------------------------- ! input/output variables integer, intent(in) :: logunit - logical, intent(in) :: med_coupling_active(:,:) + logical, intent(in) :: med_coupling_active(:,:) ! local variables integer :: nsrc,ndst,nf,n @@ -821,7 +796,7 @@ subroutine med_fldList_Document_Merging(logunit, med_coupling_active) 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)//')' + 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 diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 83ec64615..52088c112 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -862,15 +862,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if ! 'wild fire plume height' - fldname = 'Sl_fztop' if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) + call addfld(fldListFr(complnd)%flds, 'Sl_fztop') + call addfld(fldListTo(compatm)%flds, 'Sl_fztop') 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, 'one', lnd2atm_smap) - call addmrg(fldListTo(compatm)%flds, trim(fldname), & + 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 @@ -1943,7 +1942,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld(fldListFr(compocn)%flds, 'Faoo_fco2_ocn') call addfld(fldListTo(compatm)%flds, 'Faoo_fco2_ocn') else - call addmap(fldListFr(compocn)%flds, 'Faoo_fco2_ocn', compatm, mapconsf, 'one', atm2lnd_smap) + call addmap(fldListFr(complnd)%flds, 'Faoo_fco2_ocn', compatm, mapconsf, 'one', atm2lnd_smap) ! custom merge in med_phases_prep_atm end if endif diff --git a/mediator/fd_nems.yaml b/mediator/fd_nems.yaml index 8fcf95268..9dd2ace98 100644 --- a/mediator/fd_nems.yaml +++ b/mediator/fd_nems.yaml @@ -585,5 +585,3 @@ canonical_units: W m-2 - standard_name: land_mask canonical_units: 1 - - standard_name: wave_z0_roughness_length - canonical_units: 1 diff --git a/mediator/med.F90 b/mediator/med.F90 index 3e3637529..b38997dde 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -17,7 +17,7 @@ module MED use med_methods_mod , only : State_GeomWrite => med_methods_State_GeomWrite use med_methods_mod , only : State_reset => med_methods_State_reset use med_methods_mod , only : State_getNumFields => med_methods_State_getNumFields - use med_methods_mod , only : State_GetScalar => med_methods_State_GetScalar + use med_methods_mod , only : State_GetScalar => med_methods_State_GetScalar use med_methods_mod , only : FB_Init => med_methods_FB_init use med_methods_mod , only : FB_Init_pointer => med_methods_FB_Init_pointer use med_methods_mod , only : FB_Reset => med_methods_FB_Reset @@ -25,7 +25,7 @@ module MED use med_methods_mod , only : FB_FldChk => med_methods_FB_FldChk use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : clock_timeprint => med_methods_clock_timeprint - use med_time_mod , only : alarmInit => med_time_alarmInit + use med_time_mod , only : alarmInit => med_time_alarmInit use med_utils_mod , only : memcheck => med_memcheck use med_internalstate_mod , only : InternalState use med_internalstate_mod , only : med_coupling_allowed, logunit, mastertask @@ -60,7 +60,7 @@ module MED character(len=*), parameter :: grid_arbopt = "grid_reg" ! grid_reg or grid_arb character(len=*), parameter :: u_FILE_u = & __FILE__ - logical :: profile_memory = .false. + logical :: profile_memory = .true. !----------------------------------------------------------------------------- contains @@ -384,8 +384,8 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_VM, ESMF_SUCCESS use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_AttributeGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_METHOD_INITIALIZE - use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_CompAttributeGet - use med_internalstate_mod, only : mastertask, logunit + use NUOPC , only : NUOPC_CompFilterPhaseMap + use med_internalstate_mod, only : mastertask type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -393,13 +393,10 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables - type(ESMF_VM) :: vm - character(len=CL) :: value - integer :: localPet - logical :: isPresent, isSet - character(len=CX) :: msgString - character(len=CX) :: diro - character(len=CX) :: logfile + type(ESMF_VM) :: vm + character(len=128) :: value + integer :: localPet + character(len=CX) :: msgString character(len=*),parameter :: subname='(module_MED:InitializeP0)' !----------------------------------------------------------- @@ -412,23 +409,6 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) mastertask = .false. if (localPet == 0) mastertask=.true. - ! Determine mediator logunit - if (mastertask) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, isPresent=isPresent, isSet=isSet, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (.not. isPresent .and. .not. isSet) then - diro = './' - end if - call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, isPresent=isPresent, isSet=isSet, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (.not. isPresent .and. .not. isSet) then - logfile = 'mediator.log' - end if - open(newunit=logunit, file=trim(diro)//"/"//trim(logfile)) - else - logUnit = 6 - endif - call ESMF_AttributeGet(gcomp, name="Verbosity", value=value, defaultValue="max", & convention="NUOPC", purpose="Instance", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -485,7 +465,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) character(len=8) :: ice_present, rof_present character(len=8) :: glc_present, med_present character(len=8) :: ocn_present, wav_present - character(len=CS) :: attrList(8) + character(len=32) :: attrList(8) character(len=*),parameter :: subname='(module_MED:InitializeIPDv03p1)' !----------------------------------------------------------- @@ -550,9 +530,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name='coupling_mode', value=coupling_mode, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite('coupling_mode = '// trim(coupling_mode), ESMF_LOGMSG_INFO) - if (mastertask) then - write(logunit,*)' Mediator Coupling Mode is ',trim(coupling_mode) - end if + write(logunit,*)' Mediator Coupling Mode is ',trim(coupling_mode) if (trim(coupling_mode) == 'cesm') then call esmFldsExchange_cesm(gcomp, phase='advertise', rc=rc) @@ -731,10 +709,7 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) 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 -#if ESMF_VERSION_MINOR > 0 - use ESMF , only : ESMF_StateSet, ESMF_StateIntent_Import, ESMF_StateIntent_Export - use ESMF , only : ESMF_StateIntent_Flag -#endif + ! Input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState @@ -765,21 +740,13 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) ! Realize States do n = 1,ncomps if (ESMF_StateIsCreated(is_local%wrap%NStateImp(n), rc=rc)) then -#if ESMF_VERSION_MINOR > 0 - call ESMF_StateSet(is_local%wrap%NStateImp(n), stateIntent=ESMF_StateIntent_Import, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return -#endif call med_fldList_Realize(is_local%wrap%NStateImp(n), fldListFr(n), & is_local%wrap%flds_scalar_name, is_local%wrap%flds_scalar_num, & tag=subname//':Fr_'//trim(compname(n)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif if (ESMF_StateIsCreated(is_local%wrap%NStateExp(n), rc=rc)) then -#if ESMF_VERSION_MINOR > 0 - call ESMF_StateSet(is_local%wrap%NStateExp(n), stateIntent=ESMF_StateIntent_Export, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return -#endif - call med_fldList_Realize(is_local%wrap%NStateExp(n), fldListTo(n), & + call med_fldList_Realize(is_local%wrap%NStateExp(n), fldListTo(n), & is_local%wrap%flds_scalar_name, is_local%wrap%flds_scalar_num, & tag=subname//':To_'//trim(compname(n)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1864,7 +1831,8 @@ subroutine DataInitialize(gcomp, rc) call med_fraction_set(gcomp,rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compatm)) then + ! should this be added here? + if (is_local%wrap%comp_present(compocn)) then call med_phases_ocnalb_run(gcomp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -1877,8 +1845,8 @@ subroutine DataInitialize(gcomp, rc) 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 (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(fieldNameList(fieldCount)) @@ -1900,6 +1868,16 @@ subroutine DataInitialize(gcomp, rc) 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 (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_fraction_set(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Initialize ocean albedo module and compute ocean albedos + call med_phases_ocnalb_run(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! do the merge to the atmospheric component call med_phases_prep_atm(gcomp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2042,15 +2020,16 @@ subroutine SetRunClock(gcomp, rc) type(ESMF_Clock) :: mediatorClock, driverClock type(ESMF_Time) :: currTime type(ESMF_TimeInterval) :: timeStep - character(len=CL) :: cvalue - character(len=CL) :: restart_option ! Restart option units + 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) :: glc_avg_alarm logical :: glc_present - character(len=CS) :: glc_avg_period - integer :: glc_cpl_dt + character(len=16) :: glc_avg_period + integer :: opt_n + integer :: opt_ymd type(ESMF_ALARM) :: alarm logical :: first_time = .true. character(len=*),parameter :: subname='(module_MED:SetRunClock)' @@ -2108,14 +2087,9 @@ subroutine SetRunClock(gcomp, rc) else if (trim(glc_avg_period) == 'yearly') then call alarmInit(mediatorclock, glc_avg_alarm, 'nyears', opt_n=1, alarmname='alarm_glc_avg', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(glc_avg_period) == 'glc_coupling_period') then - call NUOPC_CompAttributeGet(gcomp, name="glc_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) glc_cpl_dt - call alarmInit(mediatorclock, glc_avg_alarm, 'nseconds', opt_n=glc_cpl_dt, alarmname='alarm_glc_avg', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)// ": ERROR glc_avg_period = "//trim(glc_avg_period)//" not supported", & + call ESMF_LogWrite(trim(subname)//& + ": ERROR glc_avg_period = "//trim(glc_avg_period)//" not supported", & ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_FAILURE RETURN diff --git a/mediator/med_merge_mod.F90 b/mediator/med_merge_mod.F90 index 3fa8daf17..d3d3b7a0f 100644 --- a/mediator/med_merge_mod.F90 +++ b/mediator/med_merge_mod.F90 @@ -35,6 +35,7 @@ module med_merge_mod private :: med_merge_auto_field + character(len=CL) :: errmsg character(*),parameter :: u_FILE_u = & __FILE__ @@ -44,10 +45,9 @@ module med_merge_mod subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, FBMed2, rc) - use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet - use ESMF , only : ESMF_Field, ESMF_FieldGet - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR + 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 ! ---------------------------------------------- @@ -59,7 +59,7 @@ subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, 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(med_fldList_type) , intent(in) :: fldListTo ! Information for merging + type(med_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 integer , intent(out) :: rc @@ -72,11 +72,12 @@ subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, 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) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) rc = ESMF_SUCCESS call FB_reset(FBOut, value=czero, rc=rc) @@ -147,7 +148,7 @@ subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, else call ESMF_LogWrite(trim(subname)//": ERROR merge_field = "//trim(merge_field)//" not found", & - ESMF_LOGMSG_ERROR, rc=rc) + ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_FAILURE if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -166,7 +167,7 @@ subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, else call ESMF_LogWrite(trim(subname)//": ERROR merge_field = "//trim(merge_field)//"not found", & - ESMF_LOGMSG_ERROR, rc=rc) + ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_FAILURE if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -193,7 +194,7 @@ subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, !--- clean up !--------------------------------------- - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) call t_stopf('MED:'//subname) end subroutine med_merge_auto @@ -223,14 +224,11 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld real(R8), pointer :: dp1 (:), dp2(:,:) ! output pointers to 1d and 2d fields real(R8), pointer :: dpf1(:), dpf2(:,:) ! intput pointers to 1d and 2d fields real(R8), pointer :: dpw1(:) ! weight pointer - integer :: lrank_input ! rank of input array - integer :: lrank_output ! rank of output array + integer :: lrank ! rank of array integer :: ungriddedUBound_output(1) ! currently the size must equal 1 for rank 2 fieldds integer :: ungriddedUBound_input(1) ! currently the size must equal 1 for rank 2 fieldds integer :: gridToFieldMap_output(1) ! currently the size must equal 1 for rank 2 fieldds integer :: gridToFieldMap_input(1) ! currently the size must equal 1 for rank 2 fieldds - character(len=CL) :: errmsg - character(len=CL) :: msg character(len=*),parameter :: subname=' (med_merge_mod: med_merge)' !--------------------------------------- @@ -260,19 +258,14 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld !------------------------- ! Get field pointer to output field - call ESMF_FieldBundleGet(FBout, trim(FBoutfld), field=lfield, rc=rc) + call ESMF_FieldBundleGet(FBout, fieldName=trim(FBoutfld), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, rank=lrank_output, rc=rc) + call ESMF_FieldGet(lfield, rank=lrank, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 1) then - write(msg,*)trim(subname),'output field ',trim(FBoutfld),' has rank ',lrank_output - call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO) - end if - - if (lrank_output == 1) then + if (lrank == 1) then call ESMF_FieldGet(lfield, farrayPtr=dp1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - else if (lrank_output == 2) then + else if (lrank == 2) then call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound_output, & gridToFieldMap=gridToFieldMap_output, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -281,19 +274,14 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld end if ! Get field pointer to input field used in the merge - call ESMF_FieldBundleGet(FB, FBfld, field=lfield, rc=rc) + call ESMF_FieldBundleGet(FB, fieldName=trim(FBfld), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, rank=lrank_input, rc=rc) + call ESMF_FieldGet(lfield, rank=lrank, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 1) then - write(msg,*)trim(subname),'input field ',trim(FBfld),' has rank ',lrank_input - call ESMF_LogWrite(msg, ESMF_LOGMSG_ERROR) - end if - - if (lrank_input == 1) then + if (lrank == 1) then call ESMF_FieldGet(lfield, farrayPtr=dpf1, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - else if (lrank_input == 2) then + else if (lrank == 2) then call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound_input, & gridToFieldMap=gridToFieldMap_input, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -302,28 +290,22 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld end if ! error checks - if (lrank_input /= lrank_output) then - write(errmsg,*) trim(subname),' input field rank ',lrank_input,' for '//trim(FBfld), & - ' not equal to output field rank ',lrank_output,' for '//trim(FBoutfld) - call ESMF_LogWrite(errmsg, ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - else if (lrank_output == 2) then + if (lrank == 2) then if (ungriddedUBound_output(1) /= ungriddedUBound_input(1)) then write(errmsg,*) trim(subname),"ungriddedUBound_input (",ungriddedUBound_input(1),& - ") not equal to ungriddedUBound_output (",ungriddedUBound_output(1),") for "//trim(FBoutfld) + ") not equal to ungriddedUBound_output (",ungriddedUBound_output(1),")" call ESMF_LogWrite(errmsg, ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return else if (gridToFieldMap_input(1) /= gridToFieldMap_output(1)) then write(errmsg,*) trim(subname),"gridtofieldmap_input (",gridtofieldmap_input(1),& - ") not equal to gridtofieldmap_output (",gridtofieldmap_output(1),") for "//trim(FBoutfld) + ") not equal to gridtofieldmap_output (",gridtofieldmap_output(1),")" call ESMF_LogWrite(errmsg, ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE return end if endif - ! Get pointer to weights that weights are only rank 1 if (merge_type == 'copy_with_weights' .or. merge_type == 'merge' .or. merge_type == 'sum_with_weights') then call ESMF_FieldBundleGet(FBw, fieldName=trim(fldw), field=lfield, rc=rc) @@ -334,13 +316,13 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld ! Do supported merges if (trim(merge_type) == 'copy') then - if (lrank_output == 1) then + if (lrank == 1) then dp1(:) = dpf1(:) else dp2(:,:) = dpf2(:,:) endif else if (trim(merge_type) == 'copy_with_weights') then - if (lrank_output == 1) then + if (lrank == 1) then dp1(:) = dpf1(:)*dpw1(:) else do n = 1,ungriddedUBound_input(1) @@ -352,7 +334,7 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld end do endif else if (trim(merge_type) == 'merge' .or. trim(merge_type) == 'sum_with_weights') then - if (lrank_output == 1) then + if (lrank == 1) then dp1(:) = dp1(:) + dpf1(:)*dpw1(:) else do n = 1,ungriddedUBound_input(1) @@ -364,7 +346,7 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld end do endif else if (trim(merge_type) == 'sum') then - if (lrank_output == 1) then + if (lrank == 1) then dp1(:) = dp1(:) + dpf1(:) else dp2(:,:) = dp2(:,:) + dpf2(:,:) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 8e2dbf9f6..2db2aace4 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -42,8 +42,8 @@ module med_phases_history_mod public :: med_phases_history_alarm_init public :: med_phases_history_write - ! type(ESMF_Alarm) :: alarm_hist_inst - ! type(ESMF_Alarm) :: alarm_hist_avg + ! type(ESMF_Alarm) :: alarm_hist_inst + ! type(ESMF_Alarm) :: alarm_hist_avg character(*), parameter :: u_FILE_u = & __FILE__ @@ -127,19 +127,18 @@ subroutine med_phases_history_alarm_init(gcomp, rc) ! Set alarm for averaged mediator history output ! ----------------------------- - !TODO: add isSet and isPresent flags to reading these and other config attributes - !call NUOPC_CompAttributeGet(gcomp, name='histavg_option', value=histavg_option, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !call NUOPC_CompAttributeGet(gcomp, name='histavg_n', value=cvalue, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !read(cvalue,*) histavg_n + call NUOPC_CompAttributeGet(gcomp, name='histavg_option', value=histavg_option, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name='histavg_n', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) histavg_n - !call med_time_alarmInit(mclock, alarm, option=histavg_option, opt_n=histavg_n, & - ! reftime=mStartTime, alarmname='alarm_history_avg', rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_time_alarmInit(mclock, alarm, option=histavg_option, opt_n=histavg_n, & + reftime=mStartTime, alarmname='alarm_history_avg', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - !call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Advance model clock to trigger alarms then reset model clock back to currtime @@ -165,8 +164,8 @@ subroutine med_phases_history_alarm_init(gcomp, rc) write(logunit,100) trim(subname)//" history clock timestep = ",timestep_length write(logunit,100) trim(subname)//" set instantaneous mediator history alarm with option "//& trim(histinst_option)//" and frequency ",histinst_n - !write(logunit,100) trim(subname)//" set averaged mediator history alarm with option "//& - ! trim(histavg_option)//" and frequency ",histavg_n + write(logunit,100) trim(subname)//" set averaged mediator history alarm with option "//& + trim(histavg_option)//" and frequency ",histavg_n 100 format(a,2x,i8) write(logunit,*) end if @@ -214,6 +213,7 @@ subroutine med_phases_history_write(gcomp, rc) integer :: alarmCount type(ESMF_VM) :: vm 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 @@ -301,31 +301,30 @@ subroutine med_phases_history_write(gcomp, rc) ! alarmisOn = .false. ! endif + !DEBUG call ESMF_ClockGetAlarm(mclock, alarmname='alarm_history_inst', alarm=alarm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (dbug_flag > 2) then - call ESMF_AlarmGet(alarm, ringInterval=ringInterval, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeIntervalGet(ringInterval, s=ringinterval_length, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(mclock, currtime=currtime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then - write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - write(logunit,*) - write(logunit,*) trim(subname)//": history alarm ringinterval = ", ringInterval_length - write(logunit,' (a)') trim(subname)//": currtime = "//trim(currtimestr)//" nexttime = "//trim(nexttimestr) - write(logunit,*) trim(subname) //' history alarm is ringing = ', ESMF_AlarmIsRinging(alarm) - end if + call ESMF_AlarmGet(alarm, ringInterval=ringInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeIntervalGet(ringInterval, s=ringinterval_length, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet(mclock, currtime=currtime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + if (mastertask .and. dbug_flag>2) then + write(logunit,*) + write(logunit,*) trim(subname)//": history alarm ringinterval = ", ringInterval_length + write(logunit,' (a)') trim(subname)//": currtime = "//trim(currtimestr)//" nexttime = "//trim(nexttimestr) + write(logunit,*) trim(subname) //' history alarm is ringing = ', ESMF_AlarmIsRinging(alarm) end if + !DEBUG if (ESMF_AlarmIsRinging(alarm, rc=rc)) then if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -338,7 +337,7 @@ subroutine med_phases_history_write(gcomp, rc) call ESMF_GridCompGet(gcomp, clock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(mclock, currtime=currtime, starttime=starttime, calendar=calendar, rc=rc) + call ESMF_ClockGet(mclock, currtime=currtime, reftime=reftime, starttime=starttime, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) @@ -351,12 +350,12 @@ subroutine med_phases_history_write(gcomp, rc) call ESMF_TimeGet(nexttime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - timediff = nexttime - starttime + timediff = nexttime - reftime call ESMF_TimeIntervalGet(timediff, d=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return dayssince = day + sec/real(SecPerDay,R8) - call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + call ESMF_TimeGet(reftime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_ymd2date(yr,mon,day,start_ymd) start_tod = sec @@ -428,7 +427,6 @@ subroutine med_phases_history_write(gcomp, rc) call med_io_write(hist_file, iam, is_local%wrap%FBMed_ocnalb_o, & nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='Med_alb_ocn', rc=rc) end if - !TODO: don't write aoflux_(oa) when they're not being used if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o,rc=rc)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 6d221f0b3..14c7dd3c9 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -251,7 +251,6 @@ subroutine med_phases_ocnalb_run(gcomp, rc) 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 - character(CL) :: msg logical :: first_call = .true. character(len=*) , parameter :: subname='(med_phases_ocnalb_run)' !--------------------------------------- @@ -300,12 +299,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) call t_startf('MED:'//subname) - ! get clock - call ESMF_GridCompGet(gcomp, clock=clock) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (first_call) then - ! Initialize ocean albedo calculation call med_phases_ocnalb_init(gcomp, ocnalb, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -326,6 +320,8 @@ subroutine med_phases_ocnalb_run(gcomp, rc) return end if + call ESMF_GridCompGet(gcomp, clock=clock) + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet( clock, currTime=currTime, timeStep=timeStep, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -380,9 +376,6 @@ subroutine med_phases_ocnalb_run(gcomp, rc) else ! Solar declination ! Will only do albedo calculation if nextsw_cday is not -1. - write(msg,*)trim(subname)//' nextsw_cday = ',nextsw_cday - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) - if (nextsw_cday >= -0.5_r8) then call shr_orb_decl(nextsw_cday, eccen, mvelpp,lambm0, obliqr, delta, eccf) diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 5752ec906..e19bfe037 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -155,9 +155,7 @@ subroutine med_phases_prep_ice(gcomp, rc) end if if (trim(coupling_mode(1:4)) == 'nems') then - !TODO: the EMC CICE5 cap calculates Sa_ptem; the Sa_ptem is not an exchanged field - !so the calcuation here is un-used. It should be retained however for eventual use after - !a unified CICE6 cap is implemented + ! If either air density or ptem from atm is not available - then need pbot since it will be ! required for either calculation if ( .not. fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_dens',rc=rc) .or. & diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index cc32a43a7..32a54e6d6 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -72,8 +72,8 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! get current time - call ESMF_ClockGet(mclock, currTime=mCurrTime, rc=rc) + ! get start time + call ESMF_ClockGet(mclock, startTime=mStartTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ----------------------------- @@ -87,7 +87,7 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) read(cvalue,*) restart_n call med_time_alarmInit(mclock, alarm, option=restart_option, opt_n=restart_n, & - reftime=mcurrTime, alarmname='alarm_restart', rc=rc) + reftime=mStartTime, alarmname='alarm_restart', rc=rc) call ESMF_AlarmSet(alarm, clock=mclock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -146,9 +146,7 @@ subroutine med_phases_restart_write(gcomp, rc) ! local variables type(ESMF_VM) :: vm type(ESMF_Clock) :: clock - type(ESMF_Time) :: starttime - type(ESMF_Time) :: currtime - type(ESMF_Time) :: nexttime + type(ESMF_Time) :: currtime, reftime, starttime, nexttime type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time type(ESMF_Alarm) :: alarm type(ESMF_Calendar) :: calendar @@ -160,11 +158,13 @@ subroutine med_phases_restart_write(gcomp, rc) 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 start time + real(R8) :: dayssince ! Time interval since reference time integer :: unitn ! unit number character(ESMF_MAXSTR) :: time_units ! units of time variable character(ESMF_MAXSTR) :: case_name ! case name @@ -178,7 +178,8 @@ subroutine med_phases_restart_write(gcomp, rc) real(R8) :: tbnds(2) ! CF1.0 time bounds logical :: whead,wdata ! for writing restart/restart cdf files integer :: iam ! vm stuff - character(ESMF_MAXSTR) :: tmpstr + character(len=ESMF_MAXSTR) :: tmpstr + integer :: dbrc logical :: isPresent logical :: first_time = .true. character(len=*), parameter :: subname='(med_phases_restart_write)' @@ -186,7 +187,7 @@ subroutine med_phases_restart_write(gcomp, rc) call t_startf('MED:'//subname) if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) endif rc = ESMF_SUCCESS @@ -245,7 +246,7 @@ subroutine med_phases_restart_write(gcomp, rc) endif if (alarmIsOn) then - call ESMF_ClockGet(clock, currtime=currtime, starttime=starttime, rc=rc) + call ESMF_ClockGet(clock, currtime=currtime, reftime=reftime, starttime=starttime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) @@ -254,43 +255,45 @@ subroutine med_phases_restart_write(gcomp, rc) call ESMF_ClockGet(clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) + call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO) + 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=rc) + call ESMF_TimeGet(nexttime,yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": nexttime = "//trim(nexttimestr), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": nexttime = "//trim(nexttimestr), ESMF_LOGMSG_INFO, rc=dbrc) endif if (mastertask) then - call ESMF_ClockPrint(clock, options="currTime", & - preString="-------->"//trim(subname)//" mediating for: ", unit=cvalue, rc=rc) + call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//& + " mediating for: ", unit=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(logunit, *) trim(cvalue) endif - timediff = nexttime - starttime + timediff = nexttime - reftime call ESMF_TimeIntervalGet(timediff, d=day, s=sec, rc=rc) dayssince = day + sec/real(SecPerDay,R8) - call ESMF_TimeGet(starttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ymd2date(yr, mon, day, start_ymd) + 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, rc) + time_units = 'days since ' & + // trim(med_io_date2yyyymmdd(start_ymd)) // ' ' // med_io_sec2hms(start_tod, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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 @@ -300,17 +303,18 @@ subroutine med_phases_restart_write(gcomp, rc) ! 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' + write(restart_file,"(6a)") & + trim(case_name), '.cpl',trim(cpl_inst_tag),'.r.', trim(nexttimestr),'.nc' if (iam == 0) then restart_pfile = "rpointer.cpl"//cpl_inst_tag - call ESMF_LogWrite(trim(subname)//" write rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//" write rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO, rc=dbrc) open(newunit=unitn, file=restart_pfile, form='FORMATTED') write(unitn,'(a)') trim(restart_file) close(unitn) endif - call ESMF_LogWrite(trim(subname)//": write "//trim(restart_file), ESMF_LOGMSG_INFO) + 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 @@ -326,7 +330,7 @@ subroutine med_phases_restart_write(gcomp, rc) end if tbnds = dayssince - call ESMF_LogWrite(trim(subname)//": time "//trim(time_units), ESMF_LOGMSG_INFO) + 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, calendar=calendar, time_val=dayssince, & @@ -347,6 +351,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_write(restart_file, iam, start_tod, 'start_tod', whead=whead, wdata=wdata, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_write(restart_file, iam, ref_ymd , 'ref_ymd' , whead=whead, wdata=wdata, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_write(restart_file, iam, ref_tod , 'ref_tod' , whead=whead, wdata=wdata, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_write(restart_file, iam, next_ymd , 'curr_ymd' , whead=whead, wdata=wdata, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_write(restart_file, iam, next_tod , 'curr_tod' , whead=whead, wdata=wdata, rc=rc) @@ -367,7 +375,7 @@ subroutine med_phases_restart_write(gcomp, rc) ! Write import field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny - !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + !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 (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -376,7 +384,7 @@ subroutine med_phases_restart_write(gcomp, rc) ! Write export field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny - !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) call med_io_write(restart_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 (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -385,7 +393,7 @@ subroutine med_phases_restart_write(gcomp, rc) ! Write fraction field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny - !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + !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 (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -395,7 +403,7 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccum(n),rc=rc)) then ! TODO: only write this out if actually have done accumulation !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny - !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + !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 (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -405,7 +413,7 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBImpAccum(n,n),rc=rc)) then ! TODO: only write this out if actually have done accumulation !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny - !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) call med_io_write(restart_file, iam, is_local%wrap%FBImpAccum(n,n), & nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'ImpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -435,7 +443,7 @@ subroutine med_phases_restart_write(gcomp, rc) !--------------------------------------- if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) endif call t_stopf('MED:'//subname) @@ -473,12 +481,13 @@ subroutine med_phases_restart_read(gcomp, rc) 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 + integer :: dbrc logical :: isPresent character(len=*), parameter :: sp_str = 'str_undefined' character(len=*), parameter :: subname='(med_phases_restart_read)' !--------------------------------------- call t_startf('MED:'//subname) - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) rc = ESMF_SUCCESS !--------------------------------------- @@ -516,11 +525,11 @@ subroutine med_phases_restart_read(gcomp, rc) call ESMF_ClockGet(clock, currtime=currtime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) + call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO) + 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) @@ -535,25 +544,25 @@ subroutine med_phases_restart_read(gcomp, rc) restart_pfile = "rpointer.cpl"//cpl_inst_tag if (iam == 0) then - call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO, rc=dbrc) open(newunit=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) + 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) + call ESMF_LogWrite(trim(subname)//' rpointer file read returns error', ESMF_LOGMSG_INFO, rc=dbrc) rc=ESMF_Failure return end if close(unitn) - call ESMF_LogWrite(trim(subname)//' restart file from rpointer = '//trim(restart_file), ESMF_LOGMSG_INFO) + 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) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": read "//trim(restart_file), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": read "//trim(restart_file), ESMF_LOGMSG_INFO, rc=dbrc) ! Now read in the restart file @@ -566,31 +575,36 @@ subroutine med_phases_restart_read(gcomp, rc) 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) + call med_io_read(restart_file, vm, iam, is_local%wrap%FBimp(n,n), & + pre=trim(compname(n))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Read export field bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExp(n),rc=rc)) then - call med_io_read(restart_file, vm, iam, is_local%wrap%FBexp(n), pre=trim(compname(n))//'Exp', rc=rc) + call med_io_read(restart_file, vm, iam, is_local%wrap%FBexp(n), & + pre=trim(compname(n))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Read fraction field bundles 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) + call med_io_read(restart_file, vm, iam, is_local%wrap%FBfrac(n), & + pre=trim(compname(n))//'Frac', rc=rc) if (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) + call med_io_read(restart_file, vm, iam, is_local%wrap%FBExpAccum(n), & + pre=trim(compname(n))//'ExpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Read import field bundle accumulator if (ESMF_FieldBundleIsCreated(is_local%wrap%FBImpAccum(n,n),rc=rc)) then - call med_io_read(restart_file, vm, iam, is_local%wrap%FBImpAccum(n,n), pre=trim(compname(n))//'ImpAccum', rc=rc) + call med_io_read(restart_file, vm, iam, is_local%wrap%FBImpAccum(n,n), & + pre=trim(compname(n))//'ImpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif endif @@ -598,7 +612,8 @@ subroutine med_phases_restart_read(gcomp, rc) ! 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) + call med_io_read(restart_file, vm, iam, is_local%wrap%FBMed_ocnalb_o, & + pre='MedOcnAlb_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -606,7 +621,7 @@ subroutine med_phases_restart_read(gcomp, rc) !--- clean up !--------------------------------------- - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) call t_stopf('MED:'//subname) end subroutine med_phases_restart_read diff --git a/nuopc_cap_share/nuopc_shr_methods.F90 b/nuopc_cap_share/nuopc_shr_methods.F90 deleted file mode 100644 index 44ead6c8f..000000000 --- a/nuopc_cap_share/nuopc_shr_methods.F90 +++ /dev/null @@ -1,845 +0,0 @@ -module nuopc_shr_methods - - use ESMF , only : operator(<), operator(/=), operator(+) - use ESMF , only : operator(-), operator(*) , operator(>=) - use ESMF , only : operator(<=), operator(>), operator(==) - use ESMF , only : ESMF_LOGERR_PASSTHRU, ESMF_LogFoundError, ESMF_LOGMSG_ERROR, ESMF_MAXSTR - use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE - use ESMF , only : ESMF_State, ESMF_StateGet - use ESMF , only : ESMF_Field, ESMF_FieldGet - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_GridCompSet - use ESMF , only : ESMF_GeomType_Flag, ESMF_FieldStatus_Flag - use ESMF , only : ESMF_Mesh, ESMF_MeshGet - use ESMF , only : ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID, ESMF_FIELDSTATUS_COMPLETE - use ESMF , only : ESMF_Clock, ESMF_ClockCreate, ESMF_ClockGet, ESMF_ClockSet - use ESMF , only : ESMF_ClockPrint, ESMF_ClockAdvance - use ESMF , only : ESMF_Alarm, ESMF_AlarmCreate, ESMF_AlarmGet, ESMF_AlarmSet - use ESMF , only : ESMF_Calendar, 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_VM, ESMF_VMGet, ESMF_VMBroadcast, ESMF_VMGetCurrent - use NUOPC , only : NUOPC_CompAttributeGet - use NUOPC_Model , only : NUOPC_ModelGet - use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_sys_mod , only : shr_sys_abort - use shr_file_mod , only : shr_file_setlogunit, shr_file_getLogUnit - - implicit none - private - - public :: memcheck - public :: get_component_instance - public :: set_component_logging - public :: log_clock_advance - public :: state_getscalar - public :: state_setscalar - public :: state_diagnose - public :: alarmInit - public :: chkerr - - private :: timeInit - private :: field_getfldptr - - ! 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" - - ! Module data - integer, parameter :: SecPerDay = 86400 ! Seconds per day - integer, parameter :: memdebug_level=1 - character(len=1024) :: msgString - character(len=*), parameter :: u_FILE_u = & - __FILE__ - -!=============================================================================== -contains -!=============================================================================== - - subroutine memcheck(string, level, mastertask) - - ! input/output variables - character(len=*) , intent(in) :: string - integer , intent(in) :: level - logical , intent(in) :: mastertask - - ! local variables - integer :: ierr - integer, external :: GPTLprint_memusage - !----------------------------------------------------------------------- - - if ((mastertask .and. memdebug_level > level) .or. memdebug_level > level+1) then - ierr = GPTLprint_memusage(string) - endif - - end subroutine memcheck - -!=============================================================================== - - subroutine get_component_instance(gcomp, inst_suffix, inst_index, rc) - - ! input/output variables - type(ESMF_GridComp) :: gcomp - character(len=*) , intent(out) :: inst_suffix - integer , intent(out) :: inst_index - integer , intent(out) :: rc - - ! local variables - logical :: isPresent - character(len=4) :: cvalue - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", isPresent=isPresent, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (isPresent) then - call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", value=inst_suffix, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - cvalue = inst_suffix(2:) - read(cvalue, *) inst_index - else - inst_suffix = "" - inst_index=1 - endif - - end subroutine get_component_instance - -!=============================================================================== - - subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) - - ! input/output variables - type(ESMF_GridComp) :: gcomp - logical, intent(in) :: mastertask - integer, intent(out) :: logunit - integer, intent(out) :: shrlogunit - integer, intent(out) :: rc - - ! local variables - character(len=CL) :: diro - character(len=CL) :: logfile - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - shrlogunit = 6 - - if (mastertask) then - call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) - if (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 set_component_logging - -!=============================================================================== - - subroutine log_clock_advance(clock, component, logunit, rc) - - ! input/output variables - type(ESMF_Clock) :: clock - character(len=*) , intent(in) :: component - integer , intent(in) :: logunit - integer , intent(out) :: rc - - ! local variables - character(len=CL) :: cvalue, prestring - !----------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - write(prestring, *) "------>Advancing ",trim(component)," from: " - call ESMF_ClockPrint(clock, options="currTime", unit=cvalue, preString=trim(prestring), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - write(logunit, *) trim(cvalue) - - call ESMF_ClockPrint(clock, options="stopTime", unit=cvalue, & - preString="--------------------------------> to: ", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - write(logunit, *) trim(cvalue) - - end subroutine log_clock_advance - -!=============================================================================== - - subroutine state_getscalar(state, scalar_id, scalar_value, flds_scalar_name, flds_scalar_num, rc) - - ! ---------------------------------------------- - ! Get scalar data from State for a particular name and broadcast it to all other pets - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_State), intent(in) :: state - integer, intent(in) :: scalar_id - real(r8), intent(out) :: scalar_value - character(len=*), intent(in) :: flds_scalar_name - integer, intent(in) :: flds_scalar_num - integer, intent(inout) :: rc - - ! local variables - integer :: mytask, ierr, len - type(ESMF_VM) :: vm - type(ESMF_Field) :: field - real(r8), pointer :: farrayptr(:,:) - real(r8) :: tmp(1) - character(len=*), parameter :: subname='(state_getscalar)' - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_VMGetCurrent(vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, localPet=mytask, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (mytask == 0) then - call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then - call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - endif - tmp(:) = farrayptr(scalar_id,:) - endif - call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - scalar_value = tmp(1) - - end subroutine state_getscalar - -!================================================================================ - - subroutine state_setscalar(scalar_value, scalar_id, State, flds_scalar_name, flds_scalar_num, rc) - - ! ---------------------------------------------- - ! Set scalar data from State for a particular name - ! ---------------------------------------------- - - ! input/output arguments - real(r8), intent(in) :: scalar_value - integer, intent(in) :: scalar_id - type(ESMF_State), intent(inout) :: State - character(len=*), intent(in) :: flds_scalar_name - integer, intent(in) :: flds_scalar_num - integer, intent(inout) :: rc - - ! local variables - integer :: mytask - type(ESMF_Field) :: lfield - type(ESMF_VM) :: vm - real(r8), pointer :: farrayptr(:,:) - character(len=*), parameter :: subname='(state_setscalar)' - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_VMGetCurrent(vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, localPet=mytask, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (mytask == 0) then - call ESMF_FieldGet(lfield, farrayPtr = farrayptr, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then - call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - endif - farrayptr(scalar_id,1) = scalar_value - endif - - end subroutine state_setscalar - -!=============================================================================== - - subroutine state_diagnose(State, string, rc) - - ! ---------------------------------------------- - ! Diagnose status of State - ! ---------------------------------------------- - - type(ESMF_State), intent(in) :: state - character(len=*), intent(in) :: string - integer , intent(out) :: rc - - ! local variables - integer :: i,j,n - type(ESMf_Field) :: lfield - integer :: fieldCount, lrank - character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) - real(r8), pointer :: dataPtr1d(:) - real(r8), pointer :: dataPtr2d(:,:) - character(len=*),parameter :: subname='(state_diagnose)' - ! ---------------------------------------------- - - call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lfieldnamelist(fieldCount)) - - call ESMF_StateGet(state, itemNameList=lfieldnamelist, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - do n = 1, fieldCount - - call ESMF_StateGet(state, itemName=lfieldnamelist(n), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call field_getfldptr(lfield, fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (lrank == 0) then - ! no local data - elseif (lrank == 1) then - if (size(dataPtr1d) > 0) then - write(msgString,'(A,a)') trim(string)//': for 1d field '//trim(lfieldnamelist(n)) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - write(msgString,'(A,3g14.7,i8)') trim(string)//': 1d field '//trim(lfieldnamelist(n)), & - minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - else - write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data" - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - endif - elseif (lrank == 2) then - if (size(dataPtr2d) > 0) then - write(msgString,'(A,a)') trim(string)//': for 2d field '//trim(lfieldnamelist(n)) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - write(msgString,'(A,3g14.7,i8)') trim(string)//': 2d field '//trim(lfieldnamelist(n)), & - minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - else - write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data" - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - endif - else - call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return - endif - enddo - - deallocate(lfieldnamelist) - - end subroutine state_diagnose - -!=============================================================================== - - subroutine field_getfldptr(field, fldptr1, fldptr2, rank, abort, rc) - - ! ---------------------------------------------- - ! for a field, determine rank and return fldptr1 or fldptr2 - ! abort is true by default and will abort if fldptr is not yet allocated in field - ! rank returns 0, 1, or 2. 0 means fldptr not allocated and abort=false - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_Field) , intent(in) :: field - real(r8), pointer , intent(inout), optional :: fldptr1(:) - real(r8), pointer , intent(inout), optional :: fldptr2(:,:) - integer , intent(out) , optional :: rank - logical , intent(in) , optional :: abort - integer , intent(out) , optional :: rc - - ! local variables - type(ESMF_GeomType_Flag) :: geomtype - type(ESMF_FieldStatus_Flag) :: status - type(ESMF_Mesh) :: lmesh - integer :: lrank, nnodes, nelements - logical :: labort - character(len=*), parameter :: subname='(field_getfldptr)' - ! ---------------------------------------------- - - if (.not.present(rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR rc not present ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - - rc = ESMF_SUCCESS - - labort = .true. - if (present(abort)) then - labort = abort - endif - lrank = -99 - - call ESMF_FieldGet(field, status=status, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (status /= ESMF_FIELDSTATUS_COMPLETE) then - lrank = 0 - if (labort) then - call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - else - call ESMF_LogWrite(trim(subname)//": WARNING data not allocated ", ESMF_LOGMSG_INFO, rc=rc) - endif - else - - call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (geomtype == ESMF_GEOMTYPE_GRID) then - call ESMF_FieldGet(field, rank=lrank, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - elseif (geomtype == ESMF_GEOMTYPE_MESH) then - call ESMF_FieldGet(field, rank=lrank, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, mesh=lmesh, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (nnodes == 0 .and. nelements == 0) lrank = 0 - else - call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", & - ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - endif ! geomtype - - if (lrank == 0) then - call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", & - ESMF_LOGMSG_INFO) - elseif (lrank == 1) then - if (.not.present(fldptr1)) then - call ESMF_LogWrite(trim(subname)//": ERROR missing rank=1 array ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - call ESMF_FieldGet(field, farrayPtr=fldptr1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - elseif (lrank == 2) then - if (.not.present(fldptr2)) then - call ESMF_LogWrite(trim(subname)//": ERROR missing rank=2 array ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - call ESMF_FieldGet(field, farrayPtr=fldptr2, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - call ESMF_LogWrite(trim(subname)//": ERROR in rank ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - endif - - endif ! status - - if (present(rank)) then - rank = lrank - endif - - end subroutine field_getfldptr - -!=============================================================================== - - subroutine alarmInit( clock, alarm, option, & - opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) - - ! 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 = '(set_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 (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! initial guess of next alarm, this will be updated below - 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 (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optNever) - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optDate) - if (.not. present(opt_ymd)) then - call shr_sys_abort(subname//trim(option)//' requires opt_ymd') - end if - if (lymd < 0 .or. ltod < 0) then - call shr_sys_abort(subname//trim(option)//'opt_ymd, opt_tod invalid') - end if - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call timeInit(NextAlarm, lymd, cal, ltod, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (optIfdays0) - if (.not. present(opt_ymd)) then - call shr_sys_abort(subname//trim(option)//' requires opt_ymd') - end if - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (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 (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - - case (optNSteps) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNStep) - if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') - call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNSeconds) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNSecond) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMinutes) - call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_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_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNHours) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNHour) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNDays) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNDay) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMonths) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNMonth) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (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 (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - - case (optNYears) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - update_nextalarm = .true. - - case (optNYear) - if (.not.present(opt_n)) then - call shr_sys_abort(subname//trim(option)//' requires opt_n') - end if - if (opt_n <= 0) then - call shr_sys_abort(subname//trim(option)//' invalid opt_n') - end if - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (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 (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .true. - - case default - call shr_sys_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 (chkerr(rc,__LINE__,u_FILE_u)) return - - end subroutine alarmInit - -!=============================================================================== - - subroutine timeInit( Time, ymd, cal, tod, rc) - - ! 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) :: tod ! time of day in seconds - integer , intent(out) :: rc - - ! local variables - integer :: year, mon, day ! year, month, day as integers - integer :: tdate ! temporary date - integer :: date ! coded-date (yyyymmdd) - character(len=*), parameter :: subname='(timeInit)' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - if ( (ymd < 0) .or. (tod < 0) .or. (tod > SecPerDay) )then - call shr_sys_abort( subname//'ERROR yymmdd is a negative number or time-of-day out of bounds' ) - end if - - tdate = abs(date) - year = int(tdate/10000) - if (date < 0) year = -year - mon = int( mod(tdate,10000)/ 100) - day = mod(tdate, 100) - - call ESMF_TimeSet( Time, yy=year, mm=mon, dd=day, s=tod, calendar=cal, rc=rc ) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - end subroutine timeInit - -!=============================================================================== - - logical function chkerr(rc, line, file) - - integer, intent(in) :: rc - integer, intent(in) :: line - character(len=*), intent(in) :: file - - integer :: lrc - - chkerr = .false. - lrc = rc - if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then - chkerr = .true. - endif - end function chkerr - -end module nuopc_shr_methods From 7e01f7c4f024a3172c86918556b5c8aa7deb4202 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Sat, 9 May 2020 16:37:35 -0400 Subject: [PATCH 04/32] merge (#7) * driver build directory needs to be set in buildexe * Add EXTRA_MACHDIR xml variable This is needed to work with the changes in https://github.com/ESMCI/cime/pull/3508 * Add the NONLOCAL xml variable This hadn't been added to the CMEPS config_component file Co-authored-by: Jim Edwards Co-authored-by: Bill Sacks --- cime_config/buildexe | 5 +++-- cime_config/config_component.xml | 17 +++++++++++++++++ 2 files changed, 20 insertions(+), 2 deletions(-) diff --git a/cime_config/buildexe b/cime_config/buildexe index 83d211ac9..80e62da71 100755 --- a/cime_config/buildexe +++ b/cime_config/buildexe @@ -37,6 +37,7 @@ def _main_func(): ocn_model = case.get_value("COMP_OCN") atm_model = case.get_value("COMP_ATM") gmake_args = get_standard_makefile_args(case) + blddir = os.path.join(case.get_value("EXEROOT"),"cpl","obj") # Determine valid components valid_comps = [] @@ -68,7 +69,7 @@ def _main_func(): gmake_args += " IAC_PRESENT=FALSE" expect((num_esp is None) or (int(num_esp) == 1), "ESP component restricted to one instance") - with open('Filepath', 'w') as out: + with open(os.path.join(blddir,'Filepath'), 'w') as out: if not skip_mediator: out.write(os.path.join(cimeroot, "src", "drivers", "nuopc", "mediator") + "\n") out.write(os.path.join(caseroot, "SourceMods", "src.drv") + "\n") @@ -85,7 +86,7 @@ def _main_func(): cmd = "{} exec_se -j {} EXEC_SE={} MODEL=driver {} -f {} "\ .format(gmake, gmake_j, exename, gmake_args, makefile) - rc, out, err = run_cmd(cmd) + rc, out, err = run_cmd(cmd, from_dir=blddir) expect(rc==0,"Command {} failed rc={}\nout={}\nerr={}".format(cmd,rc,out,err)) logger.info(out) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 372da834a..cf491341e 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -61,6 +61,15 @@ full pathname of case + + logical + TRUE,FALSE + FALSE + case_def + env_case.xml + user is not on the requested machine + + char $CASEROOT/Tools @@ -1659,6 +1668,14 @@ Machines directory location + + char + + case_def + env_case.xml + Path to an extra directory containing supplementary machines files + + char $CIME_OUTPUT_ROOT/$CASE/run From 3035e07b7389860cc75bb1d2aede3297a098d993 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Tue, 12 May 2020 09:59:58 -0400 Subject: [PATCH 05/32] merge master (#10) * driver build directory needs to be set in buildexe * Add EXTRA_MACHDIR xml variable This is needed to work with the changes in https://github.com/ESMCI/cime/pull/3508 * Add the NONLOCAL xml variable This hadn't been added to the CMEPS config_component file * update mediator to support CICE6 coupling in UFS * remove med_map_FB_Regrid_Norm_Frac Co-authored-by: Jim Edwards Co-authored-by: Bill Sacks Co-authored-by: apcraig --- mediator/esmFlds.F90 | 35 +- mediator/esmFldsExchange_nems_mod.F90 | 4 +- mediator/med_fraction_mod.F90 | 64 ++-- mediator/med_map_mod.F90 | 444 ++++++++++---------------- mediator/med_methods_mod.F90 | 69 ---- mediator/med_phases_history_mod.F90 | 1 - mediator/med_phases_ocnalb_mod.F90 | 5 +- mediator/med_phases_prep_glc_mod.F90 | 7 +- mediator/med_phases_prep_ice_mod.F90 | 162 +++++++--- mediator/med_phases_prep_lnd_mod.F90 | 6 +- mediator/med_phases_prep_rof_mod.F90 | 16 +- 11 files changed, 373 insertions(+), 440 deletions(-) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index f93a60a73..944f31b3d 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -93,7 +93,8 @@ module esmflds interface med_fldList_GetFldInfo ; module procedure & med_fldList_GetFldInfo_general, & med_fldList_GetFldInfo_stdname, & - med_fldList_GetFldInfo_merging + med_fldList_GetFldInfo_merging, & + med_fldList_GetFldInfo_index end interface !----------------------------------------------- @@ -593,23 +594,47 @@ end subroutine med_fldList_GetFldInfo_general !================================================================================ - subroutine med_fldList_GetFldInfo_stdname(fldList, fldindex, stdname) + subroutine med_fldList_GetFldInfo_stdname(fldList, fldindex_in, stdname_out) ! ---------------------------------------------- ! Get field info ! ---------------------------------------------- type(med_fldList_type) , intent(in) :: fldList - integer , intent(in) :: fldindex - character(len=*) , intent(out) :: stdname + integer , intent(in) :: fldindex_in + character(len=*) , intent(out) :: stdname_out ! local variables character(len=*), parameter :: subname='(med_fldList_GetFldInfo_stdname)' ! ---------------------------------------------- - stdname = fldList%flds(fldindex)%stdname + stdname_out = fldList%flds(fldindex_in)%stdname end subroutine med_fldList_GetFldInfo_stdname !================================================================================ + subroutine med_fldList_GetFldInfo_index(fldList, stdname_in, fldindex_out) + ! ---------------------------------------------- + ! Get field info + ! ---------------------------------------------- + type(med_fldList_type) , intent(in) :: fldList + character(len=*) , intent(in) :: stdname_in + integer , intent(out) :: fldindex_out + + ! local variables + integer :: n + character(len=*), parameter :: subname='(med_fldList_GetFldInfo_index)' + ! ---------------------------------------------- + + fldindex_out = 0 + if (associated(fldList%flds)) then + do n = 1,size(fldList%flds) + if (trim(fldList%flds(n)%stdname) == stdname_in) fldindex_out = n + enddo + endif + + end subroutine med_fldList_GetFldInfo_index + + !================================================================================ + subroutine med_fldList_GetFldInfo_merging(fldList, fldindex, compsrc, merge_field, merge_type, merge_fracname) ! ---------------------------------------------- ! Get field merge info diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index e3bdc095b..dee43b598 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -289,8 +289,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! 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 - allocate(flds(7)) - flds = (/'Sa_z ', 'Sa_pbot ', 'Sa_tbot ', 'Sa_dens ', 'Sa_u ', 'Sa_v ', 'Sa_shum '/) + allocate(flds(8)) + flds = (/'Sa_z ', 'Sa_pbot ', 'Sa_tbot ', 'Sa_ptem ', 'Sa_dens ', 'Sa_u ', 'Sa_v ', 'Sa_shum '/) do n = 1,size(flds) fldname = trim(flds(n)) call addfld(fldListTo(compice)%flds, trim(fldname)) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index cdba688f5..af27e3d35 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -119,9 +119,9 @@ module med_fraction_mod use med_methods_mod , only : FB_init => med_methods_FB_init use med_methods_mod , only : FB_reset => med_methods_FB_reset use med_methods_mod , only : FB_getFldPtr => med_methods_FB_getFldPtr - use med_methods_mod , only : FB_FieldRegrid => med_methods_FB_FieldRegrid use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_fldChk => med_methods_FB_fldChk + use med_map_mod , only : FB_FieldRegrid => med_map_FB_Field_Regrid use esmFlds , only : ncomps implicit none @@ -172,12 +172,12 @@ subroutine med_fraction_init(gcomp, rc) 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_GridCompGet, ESMF_StateIsCreated use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleIsCreated, ESMF_FieldBundleDestroy use esmFlds , only : compatm, compocn, compice, complnd use esmFlds , only : comprof, compglc, compwav, compname use esmFlds , only : mapconsf, mapfcopy - use med_map_mod , only : med_map_Fractions_init + use med_map_mod , only : med_map_Fractions_init, med_map_RH_is_created use med_internalstate_mod , only : InternalState use perf_mod , only : t_startf, t_stopf @@ -269,11 +269,11 @@ subroutine med_fraction_init(gcomp, rc) 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 + if (med_map_RH_is_created(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 + if (.not. med_map_RH_is_created(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), & @@ -284,7 +284,7 @@ subroutine med_fraction_init(gcomp, rc) call FB_FieldRegrid(& is_local%wrap%FBfrac(compatm), 'afrac', & is_local%wrap%FBfrac(n), 'afrac', & - is_local%wrap%RH(compatm,n,maptype), rc=rc) + is_local%wrap%RH(compatm,n,:),maptype, rc=rc) if(ChkErr(rc,__LINE__,u_FILE_u)) return endif end if @@ -320,14 +320,14 @@ subroutine med_fraction_init(gcomp, rc) end if ! Determine map type - if (ESMF_RouteHandleIsCreated(is_local%wrap%RH(compatm,complnd,mapfcopy), rc=rc)) then + if (med_map_RH_is_created(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 (.not. med_map_RH_is_created(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), & @@ -347,7 +347,7 @@ subroutine med_fraction_init(gcomp, rc) call FB_FieldRegrid(& is_local%wrap%FBfrac(complnd), 'lfrin', & is_local%wrap%FBfrac(compatm), 'lfrin', & - is_local%wrap%RH(complnd,compatm,maptype), rc=rc) + is_local%wrap%RH(complnd,compatm,:),maptype, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Destroy temporary field bundle if created @@ -375,12 +375,12 @@ subroutine med_fraction_init(gcomp, rc) ! 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 + if (med_map_RH_is_created(is_local%wrap%RH(compice,compatm,:),mapfcopy, rc=rc)) then maptype = mapfcopy else maptype = mapconsf end if - if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(compice,compatm,maptype), rc=rc)) then + if (.not. med_map_RH_is_created(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), & @@ -390,7 +390,7 @@ subroutine med_fraction_init(gcomp, rc) call FB_FieldRegrid(& is_local%wrap%FBfrac(compice), 'ifrac', & is_local%wrap%FBfrac(compatm), 'ifrac', & - is_local%wrap%RH(compice,compatm,maptype), rc=rc) + is_local%wrap%RH(compice,compatm,:),maptype, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if endif @@ -410,7 +410,7 @@ subroutine med_fraction_init(gcomp, rc) 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 + if (.not. med_map_RH_is_created(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), & @@ -420,7 +420,7 @@ subroutine med_fraction_init(gcomp, rc) call FB_FieldRegrid(& is_local%wrap%FBfrac(compocn), 'ofrac', & is_local%wrap%FBfrac(compatm), 'ofrac', & - is_local%wrap%RH(compocn,compatm,mapconsf), rc=rc) + is_local%wrap%RH(compocn,compatm,:),mapconsf, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end if @@ -488,7 +488,7 @@ subroutine med_fraction_init(gcomp, rc) 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 + if (.not. med_map_RH_is_created(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), & @@ -498,7 +498,7 @@ subroutine med_fraction_init(gcomp, rc) call FB_FieldRegrid(& is_local%wrap%FBfrac(compatm), 'lfrac', & is_local%wrap%FBfrac(complnd), 'lfrac', & - is_local%wrap%RH(compatm,complnd,mapconsf), rc=rc) + is_local%wrap%RH(compatm,complnd,:),mapconsf, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if else @@ -533,7 +533,7 @@ subroutine med_fraction_init(gcomp, rc) ! 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 + if (.not. med_map_RH_is_created(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), & @@ -543,7 +543,7 @@ subroutine med_fraction_init(gcomp, rc) call FB_FieldRegrid(& is_local%wrap%FBfrac(complnd), 'lfrac', & is_local%wrap%FBfrac(comprof), 'lfrac', & - is_local%wrap%RH(complnd,comprof,mapconsf), rc=rc) + is_local%wrap%RH(complnd,comprof,:),mapconsf, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif endif @@ -568,7 +568,7 @@ subroutine med_fraction_init(gcomp, rc) ! Set 'lfrac' in FBFrac(compglc) if ( is_local%wrap%comp_present(complnd) .and. is_local%wrap%med_coupling_active(complnd,compglc)) then - if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(complnd,compglc,mapconsf), rc=rc)) then + if (.not. med_map_RH_is_created(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), & @@ -578,7 +578,7 @@ subroutine med_fraction_init(gcomp, rc) call FB_FieldRegrid(& is_local%wrap%FBfrac(complnd), 'lfrac', & is_local%wrap%FBfrac(compglc), 'lfrac', & - is_local%wrap%RH(complnd,compglc,mapconsf), rc=rc) + is_local%wrap%RH(complnd,compglc,:),mapconsf, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif endif @@ -623,14 +623,14 @@ 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_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 med_map_mod , only : med_map_Fractions_init, med_map_RH_is_created use perf_mod , only : t_startf, t_stopf ! input/output variables @@ -667,7 +667,7 @@ subroutine med_fraction_set(gcomp, rc) !--------------------------------------- if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then - if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(compice,compocn,mapfcopy), rc=rc)) then + if (.not. med_map_RH_is_created(is_local%wrap%RH(compice,compocn,:),mapfcopy, rc=rc)) then if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compice,compocn))) then call FB_init(is_local%wrap%FBImp(compice,compocn), is_local%wrap%flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compocn), & @@ -681,7 +681,7 @@ subroutine med_fraction_set(gcomp, rc) RouteHandle=is_local%wrap%RH(compice,compocn,mapfcopy), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(compocn,compice,mapfcopy), rc=rc)) then + if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compice,:),mapfcopy, rc=rc)) then if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compocn,compice))) then call FB_init(is_local%wrap%FBImp(compocn,compice), is_local%wrap%flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compice), & @@ -737,14 +737,14 @@ subroutine med_fraction_set(gcomp, rc) call FB_FieldRegrid(& is_local%wrap%FBfrac(compice), 'ifrac', & is_local%wrap%FBfrac(compocn), 'ifrac', & - is_local%wrap%RH(compice,compocn,mapfcopy), rc=rc) + is_local%wrap%RH(compice,compocn,:),mapfcopy, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Map 'ofrac' from FBfrac(compice) to FBfrac(compocn) call FB_FieldRegrid(& is_local%wrap%FBfrac(compice), 'ofrac', & is_local%wrap%FBfrac(compocn), 'ofrac', & - is_local%wrap%RH(compice,compocn,mapfcopy), rc=rc) + is_local%wrap%RH(compice,compocn,:),mapfcopy, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -759,8 +759,7 @@ subroutine med_fraction_set(gcomp, rc) call 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) + is_local%wrap%RH(compice,compatm,:),mapnstod, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ifrac', ifrac_nstod, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -768,8 +767,7 @@ subroutine med_fraction_set(gcomp, rc) call FB_FieldRegrid(& is_local%wrap%FBfrac(compice), 'ifrac', & is_local%wrap%FBfrac(compatm), 'ifrac', & - is_local%wrap%RH(compice,compatm,mapconsf), & - zeroregion=ESMF_REGION_TOTAL, rc=rc) + is_local%wrap%RH(compice,compatm,:),mapconsf, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Determine ifrac on atm grid @@ -789,7 +787,7 @@ subroutine med_fraction_set(gcomp, rc) else - if (ESMF_RouteHandleIsCreated(is_local%wrap%RH(compice,compatm,mapfcopy), rc=rc)) then + if (med_map_RH_is_created(is_local%wrap%RH(compice,compatm,:),mapfcopy, rc=rc)) then ! TODO (mvertens, 2019-11-20): this is not being used when ice and atm are on the same grid ! - this needs to be implemented maptype = mapfcopy @@ -802,7 +800,7 @@ subroutine med_fraction_set(gcomp, rc) call FB_FieldRegrid(& is_local%wrap%FBfrac(compice), 'ifrac', & is_local%wrap%FBfrac(compatm), 'ifrac', & - is_local%wrap%RH(compice,compatm,maptype), rc=rc) + is_local%wrap%RH(compice,compatm,:),maptype, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -811,7 +809,7 @@ subroutine med_fraction_set(gcomp, rc) call FB_FieldRegrid(& is_local%wrap%FBfrac(compice), 'ofrac', & is_local%wrap%FBfrac(compatm), 'ofrac', & - is_local%wrap%RH(compice,compatm,maptype), rc=rc) + is_local%wrap%RH(compice,compatm,:),maptype, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index f5df6324f..fb7cea4b5 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -2,7 +2,7 @@ module med_map_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use shr_const_mod , only : shr_const_pi - use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_LOGMSG_INFO, ESMF_LogWrite use esmFlds , only : mapbilnr, mapconsf, mapconsd, mappatch, mapfcopy use esmFlds , only : mapunset, mapnames, nmappers @@ -24,7 +24,6 @@ module med_map_mod use med_methods_mod , only : FB_reset => med_methods_FB_Reset use med_methods_mod , only : FB_Clean => med_methods_FB_Clean use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr - use med_methods_mod , only : FB_FieldRegrid => med_methods_FB_FieldRegrid use med_methods_mod , only : FB_Field_diagnose => med_methods_FB_Field_diagnose use med_methods_mod , only : FB_FldChk => med_methods_FB_FldChk use med_methods_mod , only : FB_GetFieldByName => med_methods_FB_GetFieldByName @@ -36,14 +35,20 @@ module med_map_mod ! public routines public :: med_map_RouteHandles_init + public :: med_map_RH_is_created public :: med_map_Fractions_init public :: med_map_MapNorm_init public :: med_map_FB_Regrid_Norm - public :: med_map_uv_cart3d + public :: med_map_FB_Field_Regrid + public :: med_map_Field_Regrid interface med_map_FB_Regrid_norm module procedure med_map_FB_Regrid_Norm_All - module procedure med_map_FB_Regrid_Norm_Frac + end interface + + interface med_map_RH_is_created + module procedure med_map_RH_is_created_RH3d + module procedure med_map_RH_is_created_RH1d end interface ! private module variables @@ -90,7 +95,7 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) 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_GridCompGet, ESMF_VMGet, ESMF_FieldSMMStore 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 @@ -202,18 +207,7 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) ! 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 + mapexists = med_map_RH_is_created(is_local%wrap%RH,n1,n2,mapindex,rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (.not. mapexists) then @@ -262,7 +256,7 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) 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 + .not. med_map_RH_is_created(is_local%wrap%RH(n1,n2,:),mapconsf,rc)) then call ESMF_FieldRegridStore(fldsrc, flddst, & routehandle=is_local%wrap%RH(n1,n2,mapconsf), & srcMaskValues=(/srcMaskValue/), & @@ -276,7 +270,7 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) !unmappedDstList=unmappedDstList, & rc=rc) else if ((mapindex == mapconsd .or. mapindex == mapnstod_consd) .and. & - .not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(n1,n2,mapconsd))) then + .not. med_map_RH_is_created(is_local%wrap%RH(n1,n2,:),mapconsd,rc)) then call ESMF_FieldRegridStore(fldsrc, flddst, & routehandle=is_local%wrap%RH(n1,n2,mapconsd), & srcMaskValues=(/srcMaskValue/), & @@ -303,7 +297,7 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, 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 + .not. med_map_RH_is_created(is_local%wrap%RH(n1,n2,:),mapnstod,rc)) then call ESMF_FieldRegridStore(fldsrc, flddst, & routehandle=is_local%wrap%RH(n1,n2,mapnstod), & srcMaskValues=(/srcMaskValue/), & @@ -333,8 +327,7 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) endif if (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 + if (.not.med_map_RH_is_created(is_local%wrap%RH,n1,n2,mapindex,rc=rc)) then call ESMF_LogWrite(trim(subname)//trim(string)//": failed RH "//trim(mapname), & ESMF_LOGMSG_INFO) endif @@ -352,7 +345,72 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) end subroutine med_map_RouteHandles_init - !================================================================================ +!================================================================================ + + logical function med_map_RH_is_created_RH3d(RHs,n1,n2,mapindex,rc) + + use ESMF , only : ESMF_RouteHandle + + type(ESMF_RouteHandle) , intent(in) :: RHs(:,:,:) + integer , intent(in) :: n1 + integer , intent(in) :: n2 + integer , intent(in) :: mapindex + integer , intent(out) :: rc + + ! local variables + integer :: rc1, rc2 + logical :: mapexists + character(len=*), parameter :: subname=' (med_map_RH_is_created: ) ' + + rc = ESMF_SUCCESS + + med_map_RH_is_created_RH3d = med_map_RH_is_created_RH1d(RHs(n1,n2,:),mapindex,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + end function med_map_RH_is_created_RH3d + +!================================================================================ + + logical function med_map_RH_is_created_RH1d(RHs,mapindex,rc) + + use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated + + type(ESMF_RouteHandle) , intent(in) :: RHs(:) + integer , intent(in) :: mapindex + integer , intent(out) :: rc + + ! local variables + integer :: rc1, rc2 + logical :: mapexists + character(len=*), parameter :: subname=' (med_map_RH_is_created_RH1d: ) ' + + rc = ESMF_SUCCESS + rc1 = ESMF_SUCCESS + rc2 = ESMF_SUCCESS + + mapexists = .false. + if (mapindex == mapnstod_consd .and. & + ESMF_RouteHandleIsCreated(RHs(mapnstod), rc=rc1) .and. & + ESMF_RouteHandleIsCreated(RHs(mapconsd), rc=rc2)) then + mapexists = .true. + else if (mapindex == mapnstod_consf .and. & + ESMF_RouteHandleIsCreated(RHs(mapnstod), rc=rc1) .and. & + ESMF_RouteHandleIsCreated(RHs(mapconsf), rc=rc2)) then + mapexists = .true. + else if (ESMF_RouteHandleIsCreated(RHs(mapindex), rc=rc1)) then + mapexists = .true. + end if + + med_map_RH_is_created_RH1d = mapexists + + rc = rc1 + if (chkerr(rc,__LINE__,u_FILE_u)) return + rc = rc2 + if (chkerr(rc,__LINE__,u_FILE_u)) return + + end function med_map_RH_is_created_RH1d + +!================================================================================ subroutine med_map_Fractions_init(gcomp, n1, n2, FBSrc, FBDst, RouteHandle, rc) @@ -465,7 +523,7 @@ subroutine med_map_MapNorm_init(gcomp, llogunit, rc) !--------------------------------------- use ESMF , only: ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LogFlush - use ESMF , only: ESMF_GridComp, ESMF_FieldBundle, ESMF_RouteHandleIsCreated + use ESMF , only: ESMF_GridComp, ESMF_FieldBundle, ESMF_FieldBundleGet ! input/output variables type(ESMF_GridComp) :: gcomp @@ -505,7 +563,7 @@ subroutine med_map_MapNorm_init(gcomp, llogunit, rc) 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 (med_map_RH_is_created(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 '& @@ -531,10 +589,8 @@ subroutine med_map_MapNorm_init(gcomp, llogunit, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return dataptr(:) = 1.0_R8 - call FB_FieldRegrid(& - FBTmp , normname, & - is_local%wrap%FBNormOne(n1,n2,m), normname, & - is_local%wrap%RH(n1,n2,m), rc) + call med_map_FB_Field_Regrid(FBTmp, trim(normname), is_local%wrap%FBNormOne(n1,n2,m), trim(normname), & + is_local%wrap%RH(n1,n2,:), m, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call FB_clean(FBTmp, rc=rc) @@ -567,12 +623,12 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & use ESMF , only: ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_MAXSTR use ESMF , only: ESMF_Mesh, ESMF_MeshGet, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8 use ESMF , only: ESMF_FieldBundle, ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet - use ESMF , only: ESMF_RouteHandle, ESMF_RouteHandleIsCreated + use ESMF , only: ESMF_RouteHandle use ESMF , only: ESMF_REGION_SELECT, ESMF_REGION_TOTAL use ESMF , only: ESMF_Field, ESMF_FieldGet, ESMF_FieldIsCreated use ESMF , only: ESMF_FieldDestroy, ESMF_FieldCreate use ESMF , only: ESMF_TERMORDER_SRCSEQ, ESMF_Region_Flag, ESMF_REGION_TOTAL - use ESMF , only: ESMF_REGION_SELECT, ESMF_FieldRegrid + use ESMF , only: ESMF_REGION_SELECT ! input/output variables type(med_fldList_entry_type) , pointer :: fldsSrc(:) @@ -682,25 +738,7 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & call ESMF_LogWrite(trim(subname)//" field not found in FBSrc: "//trim(fldname), ESMF_LOGMSG_INFO) else if (.not. FB_FldChk(FBDst, fldname, rc=rc)) then call ESMF_LogWrite(trim(subname)//" field not found in FBDst: "//trim(fldname), ESMF_LOGMSG_INFO) - 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 = 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 = ESMF_FAILURE - return - end if - else if (.not. ESMF_RouteHandleIsCreated(RouteHandles(mapindex), rc=rc)) then + else if (.not. med_map_RH_is_created(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) @@ -729,7 +767,7 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & call ESMF_LogWrite(trim(subname)//" --> remapping "//trim(fldname)//" with "//trim(mapnames(mapindex)), & ESMF_LOGMSG_INFO) - call med_map_uv_cart3d(usrc, vsrc, udst, vdst, RouteHandles(mapindex), rc=rc) + call med_map_uv_cart3d(usrc, vsrc, udst, vdst, RouteHandles, mapindex, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return used_cart3d_for_uvmapping = .true. @@ -755,7 +793,7 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & ! ------------------- if (mapindex == mapfcopy) then - call FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapindex), rc=rc) + call med_map_FB_Field_Regrid(FBSrc, fldname, FBDst, fldname, RouteHandles, mapindex, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else @@ -830,7 +868,7 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & end if ! regrid field with name fldname from FBsrc to FBDst - call map_field_src2dst (fldname, srcfield, dstfield, RouteHandles, mapindex, rc) + call med_map_Field_Regrid (srcfield, dstfield, RouteHandles, mapindex, subname//trim(fldname), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! restore original value @@ -855,25 +893,7 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & if (chkerr(rc,__LINE__,u_FILE_u)) return ! regrid fraction field from source to destination - if (mapindex == mapnstod_consd) then - call ESMF_FieldRegrid(frac_field_src, frac_field_dst, RouteHandles(mapnstod), & - termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldRegrid(frac_field_src, frac_field_dst, RouteHandles(mapconsd), & - termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_SELECT, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else if (mapindex == mapnstod_consf) then - call ESMF_FieldRegrid(frac_field_src, frac_field_dst, RouteHandles(mapnstod), & - termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldRegrid(frac_field_src, frac_field_dst, RouteHandles(mapconsf), & - termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_SELECT, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - call ESMF_FieldRegrid(frac_field_src, frac_field_dst, routehandle=RouteHandles(mapindex), & - termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + call med_map_Field_Regrid(frac_field_src, frac_field_dst, RouteHandles, mapindex, subname//trim(fldname), rc=rc) ! get pointer to mapped fraction call ESMF_FieldGet(frac_field_dst, farrayPtr=data_norm, rc=rc) @@ -895,7 +915,7 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & !------------------------------------------------- ! map source field to destination grid - call map_field_src2dst (trim(fldname), srcfield, dstfield, RouteHandles, mapindex, rc) + call med_map_Field_Regrid (srcfield, dstfield, RouteHandles, mapindex, subname//trim(fldname), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! obtain unity normalization factor and multiply interpolated field by reciprocal of normalization factor @@ -931,7 +951,67 @@ end subroutine med_map_FB_Regrid_Norm_All !================================================================================ - subroutine map_field_src2dst (fldname, srcfield, dstfield, RouteHandles, mapindex, rc) + subroutine med_map_FB_Field_Regrid(FBin,fldin,FBout,fldout,RouteHandles,mapindex,rc) + + ! ---------------------------------------------- + ! Regrid a field in a field bundle to another field in a field bundle + ! ---------------------------------------------- + + use ESMF , only : ESMF_FieldBundle, ESMF_RouteHandle, ESMF_Field + 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) :: RouteHandles(:) + integer , intent(in) :: mapindex + integer , intent(out) :: rc + ! ---------------------------------------------- + + ! local + type(ESMF_Field) :: field1, field2 + character(CS) :: lfldname + character(len=*),parameter :: subname='(med_map_FB_Field_Regrid)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": start", ESMF_LOGMSG_INFO) + endif + + call t_startf(subname) + rc = ESMF_SUCCESS + + lfldname=trim(fldin)//'->'//trim(fldout) + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + + if (FB_FldChk(FBin , trim(fldin) , rc=rc) .and. & + FB_FldChk(FBout, trim(fldout), rc=rc)) then + + call FB_GetFieldByName(FBin, trim(fldin), field1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call FB_GetFieldByName(FBout, trim(fldout), field2, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call med_map_Field_Regrid(field1, field2, RouteHandles, mapindex, subname//trim(lfldname), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//" field not found: "//& + trim(fldin)//","//trim(fldout), ESMF_LOGMSG_INFO) + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + call t_stopf(subname) + + end subroutine med_map_FB_Field_Regrid + + !================================================================================ + + subroutine med_map_Field_Regrid (srcfield, dstfield, RouteHandles, mapindex, fldname, rc) !--------------------------------------------------- ! map the source field to the destination field @@ -939,22 +1019,23 @@ subroutine map_field_src2dst (fldname, srcfield, dstfield, RouteHandles, mapinde use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_MAXSTR - use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet - use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldRegrid + use ESMF , only : ESMF_Field, ESMF_FieldRegrid use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_Region_Flag, ESMF_REGION_TOTAL use ESMF , only : ESMF_REGION_SELECT - use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated + use ESMF , only : ESMF_RouteHandle ! input/output variables - character(len=*) , intent(in) :: fldname type(ESMF_Field) , intent(in) :: srcfield type(ESMF_Field) , intent(inout) :: dstfield type(ESMF_RouteHandle) , intent(inout) :: RouteHandles(:) integer , intent(in) :: mapindex + character(len=*) , intent(in), optional :: fldname integer , intent(out) :: rc ! local variables logical :: checkflag = .false. + character(len=CS) :: lfldname + character(len=*), parameter :: subname='(module_MED_Map:med_map_Field_Regrid)' !--------------------------------------------------- rc = ESMF_SUCCESS @@ -962,20 +1043,24 @@ subroutine map_field_src2dst (fldname, srcfield, dstfield, RouteHandles, mapinde #ifdef DEBUG checkflag = .true. #endif + lfldname = 'unknown' + if (present(fldname)) then + lfldname = trim(fldname) + endif if (mapindex == mapnstod_consd) then call ESMF_FieldRegrid(srcfield, dstfield, routehandle=RouteHandles(mapnstod), & termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then - call Field_diagnose(dstfield, fldname, " --> after nstod: ", rc=rc) + call Field_diagnose(dstfield, lfldname, " --> after nstod: ", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if call ESMF_FieldRegrid(srcfield, dstfield, routehandle=RouteHandles(mapconsd), & termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_SELECT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then - call Field_diagnose(dstfield, fldname, " --> after consd: ", rc=rc) + call Field_diagnose(dstfield, lfldname, " --> after consd: ", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if else if (mapindex == mapnstod_consf) then @@ -983,14 +1068,14 @@ subroutine map_field_src2dst (fldname, srcfield, dstfield, RouteHandles, mapinde termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then - call Field_diagnose(dstfield, fldname, " --> after nstod: ", rc=rc) + call Field_diagnose(dstfield, lfldname, " --> after nstod: ", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if call ESMF_FieldRegrid(srcfield, dstfield, routehandle=RouteHandles(mapconsf), & termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_SELECT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then - call Field_diagnose(dstfield, fldname, " --> after consf: ", rc=rc) + call Field_diagnose(dstfield, lfldname, " --> after consf: ", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if else @@ -999,12 +1084,14 @@ subroutine map_field_src2dst (fldname, srcfield, dstfield, RouteHandles, mapinde if (chkerr(rc,__LINE__,u_FILE_u)) return end if - end subroutine map_field_src2dst + end subroutine med_map_Field_Regrid !================================================================================ subroutine norm_field_dest (fldname, dstfield, frac, rc) + use ESMF , only : ESMF_Field, ESMF_FieldGet + !------------------------------------------------ ! normalize destination mapped values by the reciprocal of the ! mapped fraction or 'one' @@ -1074,191 +1161,10 @@ end subroutine norm_field_dest !================================================================================ - 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_FieldBundle, ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet - use ESMF , only: ESMF_RouteHandle, ESMF_RouteHandleIsCreated - - ! 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 - 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) - - call 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 FB_reset(FBDst, value=czero, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - do n = 1,size(fldnames) - - ! get pointer to source field data in FBSrc - call FB_GetFldPtr(FBSrc, trim(fldnames(n)), data_src, rc=rc) - if (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 FB_init(FBSrcTmp, flds_scalar_name, & - FBgeom=FBSrc, fieldNameList=(/'data_srctmp'/), name='data_srctmp', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call FB_GetFldPtr(FBSrcTmp, 'data_srctmp', data_srctmp, rc=rc) - if (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 FB_init(FBout=FBNormSrc, flds_scalar_name=flds_scalar_name, & - FBgeom=FBSrc, fieldNameList=(/trim(mapnorm)/), name='normsrc', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call FB_GetFldPtr(FBNormSrc, trim(mapnorm), data_srcnorm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif - - call FB_reset(FBNormSrc, value=czero, rc=rc) - if (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 FB_init(FBout=FBNormDst, flds_scalar_name=flds_scalar_name, & - FBgeom=FBDst, fieldNameList=(/trim(mapnorm)/), name='normdst', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call FB_GetFldPtr(FBFrac, trim(mapnorm), data_frac, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif - - call FB_reset(FBNormDst, value=czero, rc=rc) - if (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) - 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 = 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 = 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) - else - call FB_FieldRegrid( FBSrcTmp, 'data_srctmp', FBDst, fldnames(n), RouteHandle, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - - call FB_FieldRegrid(FBNormSrc, mapnorm, FBNormDst, mapnorm, RouteHandle, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! multiply interpolated field (FBDst) by reciprocal of fraction on destination grid (FBNormDst) - call FB_GetFldPtr(FBNormDst, trim(mapnorm), data_dstnorm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call FB_GetFldPtr(FBDst, trim(fldnames(n)), data_dst, rc=rc) - if (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 FB_Field_diagnose(FBDst, fldnames(n), & - string=trim(subname) //' Mapping (' // trim(fldnames(n)) // trim(lstring), rc=rc) - if (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 FB_clean(FBSrcTmp, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - if (ESMF_FieldBundleIsCreated(FBNormSrc)) then - call FB_clean(FBNormSrc, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - if (ESMF_FieldBundleIsCreated(FBNormDst)) then - call FB_clean(FBNormDst, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - call t_stopf('MED:'//subname) - - end subroutine med_map_FB_Regrid_Norm_Frac - - !================================================================================ - - subroutine med_map_uv_cart3d(usrc, vsrc, udst, vdst, RouteHandle, rc) + subroutine med_map_uv_cart3d(usrc, vsrc, udst, vdst, RouteHandles, mapindex, rc) use ESMF, only : ESMF_Mesh, ESMF_MeshGet, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8 + use ESMF, only : ESMF_Field, ESMF_FieldGet use ESMF, only : ESMF_FieldCreate, ESMF_FieldDestroy, ESMF_FieldRegrid use ESMF, only : ESMF_RouteHandle, ESMF_TERMORDER_SRCSEQ, ESMF_REGION_TOTAL @@ -1267,7 +1173,8 @@ subroutine med_map_uv_cart3d(usrc, vsrc, udst, vdst, RouteHandle, rc) type(ESMF_Field) , intent(in) :: vsrc type(ESMF_Field) , intent(inout) :: udst type(ESMF_Field) , intent(inout) :: vdst - type(ESMF_RouteHandle) , intent(inout) :: RouteHandle + type(ESMF_RouteHandle) , intent(inout) :: RouteHandles(:) + integer , intent(in) :: mapindex integer , intent(out) :: rc ! local variables @@ -1361,8 +1268,7 @@ subroutine med_map_uv_cart3d(usrc, vsrc, udst, vdst, RouteHandle, rc) enddo ! Map all thee vector fields at once from source to destination grid - call ESMF_FieldRegrid(field3d_src, field3d_dst, RouteHandle, & - termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + call med_map_Field_Regrid(field3d_src, field3d_dst, RouteHandles, mapindex, subname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Rotate destination data back from cart3d to original diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 92dfba4d9..8061a1752 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -59,7 +59,6 @@ module med_methods_mod public med_methods_FB_getNameN public med_methods_FB_getFieldN public med_methods_FB_getFieldByName - public med_methods_FB_FieldRegrid public med_methods_FB_getNumflds public med_methods_FB_Field_diagnose public med_methods_Field_diagnose @@ -1023,74 +1022,6 @@ end subroutine med_methods_FB_reset !----------------------------------------------------------------------------- - subroutine med_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 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 :: rank - logical :: checkflag = .false. - character(len=8) :: filename - type(ESMF_Region_Flag) :: localzr - character(len=*),parameter :: subname='(med_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) - - if (med_methods_FB_FldChk(FBin , trim(fldin) , rc=rc) .and. & - med_methods_FB_FldChk(FBout, trim(fldout), rc=rc)) then - - call med_methods_FB_getFieldByName(FBin, trim(fldin), field1, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call med_methods_FB_getFieldByName(FBout, trim(fldout), field2, rc=rc) - if (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 (chkerr(rc,__LINE__,u_FILE_u)) return - else - call ESMF_LogWrite(trim(subname)//" field not found: "//& - trim(fldin)//","//trim(fldout), ESMF_LOGMSG_INFO) - endif - - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - call t_stopf(subname) - - end subroutine med_methods_FB_FieldRegrid - - !----------------------------------------------------------------------------- - subroutine med_methods_State_reset(State, value, rc) ! ---------------------------------------------- diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 8e2dbf9f6..a2ffe9371 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -27,7 +27,6 @@ module med_phases_history_mod use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr use med_methods_mod , only : FB_accum => med_methods_FB_accum use med_methods_mod , only : State_GetScalar => med_methods_State_GetScalar - use med_map_mod , only : med_map_FB_Regrid_Norm use med_internalstate_mod , only : InternalState, mastertask, logunit use med_time_mod , only : med_time_alarmInit use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 6d221f0b3..2e017cd07 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -8,7 +8,6 @@ module med_phases_ocnalb_mod use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr use med_methods_mod , only : FB_getFieldN => med_methods_FB_getFieldN use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose - use med_methods_mod , only : FB_FieldRegrid => med_methods_FB_FieldRegrid use med_methods_mod , only : State_GetScalar => med_methods_State_GetScalar use esmFlds , only : mapconsf, mapnames, compatm, compocn use perf_mod , only : t_startf, t_stopf @@ -207,8 +206,8 @@ subroutine med_phases_ocnalb_run(gcomp, rc) use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_Time, ESMF_TimeGet use ESMF , only : ESMF_VM, ESMF_VMGet use ESMF , only : ESMF_LogWrite, ESMF_LogFoundError - use ESMF , only : ESMf_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_INFO - use ESMF , only : ESMF_RouteHandleIsCreated, ESMF_FieldBundleIsCreated + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_FieldBundleIsCreated use ESMF , only : operator(+) use NUOPC , only : NUOPC_CompAttributeGet diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index edb0f9680..704c14520 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -11,7 +11,6 @@ module med_phases_prep_glc_mod use ESMF , only : ESMF_FieldBundle, ESMF_Clock use ESMF , only : ESMF_Alarm, ESMF_ClockGetAlarm, ESMF_AlarmIsRinging, ESMF_AlarmRingerOff use ESMF , only : ESMF_GridComp, ESMF_GridCompGet - use ESMF , only : ESMF_RouteHandleIsCreated use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_FieldBundleAdd use ESMF , only : ESMF_FieldBundleCreate, ESMF_FieldBundleIsCreated use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate @@ -24,7 +23,7 @@ module med_phases_prep_glc_mod use med_internalstate_mod , only : InternalState, mastertask, logunit use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag use med_internalstate_mod , only : InternalState, mastertask, logunit - use med_map_mod , only : med_map_FB_Regrid_Norm + use med_map_mod , only : med_map_FB_Regrid_Norm, med_map_RH_is_created use med_map_mod , only : med_map_Fractions_Init use med_methods_mod , only : FB_Init => med_methods_FB_init use med_methods_mod , only : FB_getFldPtr => med_methods_FB_getFldPtr @@ -220,7 +219,7 @@ subroutine med_phases_prep_glc_init(gcomp, rc) fldlist_lnd2glc%flds(3)%mapnorm(compglc) = 'lfrac' ! Create route handle if it has not been created - if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(complnd,compglc,mapbilnr))) then + if (.not. med_map_RH_is_created(is_local%wrap%RH(complnd,compglc,:),mapbilnr,rc=rc)) then call med_map_Fractions_init( gcomp, complnd, compglc, & FBSrc=FBlndAccum_lnd, & FBDst=FBlndAccum_glc, & @@ -337,7 +336,7 @@ subroutine med_phases_prep_glc_init(gcomp, rc) fldlist_glc2lnd_frac%flds(1)%mapnorm(complnd) = trim(Sg_icemask_field) ! will use FBglc_icemask ! Create route handle if it has not been created - if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(compglc,complnd,mapconsf))) then + if (.not. med_map_RH_is_created(is_local%wrap%RH(compglc,complnd,:),mapconsf,rc=rc)) then call med_map_Fractions_init( gcomp, compglc, complnd, & FBSrc=FBlndAccum_glc, & FBDst=FBlndAccum_lnd, & diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 5752ec906..989999690 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -9,18 +9,19 @@ module med_phases_prep_ice_mod use med_methods_mod , only : fldchk => med_methods_FB_FldChk use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose - use med_methods_mod , only : FB_FieldRegrid => med_methods_FB_FieldRegrid use med_methods_mod , only : FB_getNumFlds => med_methods_FB_getNumFlds use med_methods_mod , only : State_GetScalar => med_methods_State_GetScalar use med_methods_mod , only : State_SetScalar => med_methods_State_SetScalar 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_map_mod , only : med_map_FB_Regrid_Norm, med_map_RH_is_created + use med_map_mod , only : med_map_FB_Field_Regrid use med_internalstate_mod , only : InternalState, logunit, mastertask use esmFlds , only : compatm, compice, comprof, compglc, ncomps, compname use esmFlds , only : fldListFr, fldListTo - use esmFlds , only : mapbilnr + use esmFlds , only : mapnames use esmFlds , only : coupling_mode + use esmFlds , only : med_fldList_GetFldInfo use perf_mod , only : t_startf, t_stopf implicit none @@ -40,7 +41,7 @@ subroutine med_phases_prep_ice(gcomp, rc) use ESMF , only : operator(/=) use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_StateGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_FieldBundleGet, ESMF_RouteHandleIsCreated + use ESMF , only : ESMF_FieldBundleGet use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE use ESMF , only : ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND use NUOPC , only : NUOPC_IsConnected @@ -54,6 +55,8 @@ subroutine med_phases_prep_ice(gcomp, rc) type(InternalState) :: is_local integer :: i,n,n1,ncnt character(len=CS) :: fldname + integer :: fldnum + integer :: mapindex real(R8), pointer :: dataptr(:) real(R8), pointer :: temperature(:) real(R8), pointer :: pressure(:) @@ -154,45 +157,92 @@ subroutine med_phases_prep_ice(gcomp, rc) end if end if - if (trim(coupling_mode(1:4)) == 'nems') then - !TODO: the EMC CICE5 cap calculates Sa_ptem; the Sa_ptem is not an exchanged field - !so the calcuation here is un-used. It should be retained however for eventual use after - !a unified CICE6 cap is implemented - ! If either air density or ptem from atm is not available - then need pbot since it will be - ! required for either calculation - if ( .not. fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_dens',rc=rc) .or. & - .not. 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. 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 = ESMF_FAILURE - return - end if - call 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 (chkerr(rc,__LINE__,u_FILE_u)) return - end if - call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compice), 'Sa_pbot', pressure, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + ! This is a prep phase for the next two sections, Sa_dens and Sa_ptem custom calculations + ! Interpolate Sa_pbot and Sa_tbot if needed + if ((.not. fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_ptem',rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compice) , 'Sa_ptem',rc=rc)) .or. & + (.not. fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_dens',rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compice) , 'Sa_dens',rc=rc))) then - ! Get a pointer to Sa_tbot on the ice grid - call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compice), 'Sa_tbot', temperature, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_pbot',rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_tbot',rc=rc)) then + + ! interpolate fields not done as part of prep_ice + allocate(fldnames(2)) + fldnames = (/'Sa_pbot','Sa_tbot'/) + do n = 1,size(fldnames) + if (.not. fldchk(is_local%wrap%FBExp(compice), trim(fldnames(n)), rc=rc)) then + call ESMF_LogWrite(trim(subname)//": mapping "//trim(fldnames(n))//" for custom calculation", ESMF_LOGMSG_INFO) + call med_fldList_GetFldInfo(fldListFr(compatm),trim(fldnames(n)),fldnum) + mapindex = fldListFr(compatm)%flds(fldnum)%mapindex(compice) + if (.not. med_map_RH_is_created(is_local%wrap%RH(compatm,compice,:),mapindex,rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR "//trim(mapnames(mapindex))//" RH not available for atm->ice "//trim(fldnames(n)), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + end if + call med_map_FB_Field_Regrid( & + is_local%wrap%FBImp(compatm,compatm), trim(fldnames(n)), & + is_local%wrap%FBImp(compatm,compice), trim(fldnames(n)), & + is_local%wrap%RH(compatm,compice,:), mapindex, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + enddo + deallocate(fldnames) + + else + call ESMF_LogWrite(trim(subname)//": custom calculations cannot be computed due to missing fields", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + endif + + ! if Sa_dens is not sent by the atm but is required by the ice + ! compute air density as a custom calculation + ! requires Sa_shum, Sa_pbot, Sa_tbot from atm, will abort if it can't be calculated + if (.not. fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_dens',rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compice) , 'Sa_dens',rc=rc)) then + + if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_shum',rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_pbot',rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_tbot',rc=rc)) then - ! compute air density as a custom calculation - ! if Sa_dens is not sent by the atm - if ( .not. 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) + ! interpolate fields if not done as part of prep_ice + ! Sa_pbot, Sa_tbot done above, do Sa_shum here + allocate(fldnames(1)) + fldnames = (/'Sa_shum'/) + do n = 1,size(fldnames) + if (.not. fldchk(is_local%wrap%FBExp(compice), trim(fldnames(n)), rc=rc)) then + call med_fldList_GetFldInfo(fldListFr(compatm),trim(fldnames(n)),fldnum) + mapindex = fldListFr(compatm)%flds(fldnum)%mapindex(compice) + if (.not. med_map_RH_is_created(is_local%wrap%RH(compatm,compice,:),mapindex,rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR "//trim(mapnames(mapindex))//" RH not available for atm->ice "//trim(fldnames(n)), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + end if + call med_map_FB_Field_Regrid( & + is_local%wrap%FBImp(compatm,compatm), trim(fldnames(n)), & + is_local%wrap%FBImp(compatm,compice), trim(fldnames(n)), & + is_local%wrap%RH(compatm,compice,:), mapindex, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + enddo + deallocate(fldnames) + + call FB_GetFldPtr(is_local%wrap%FBExp(compice), 'Sa_dens', air_density, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compice), 'Sa_shum', humidity, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compice), 'Sa_dens', air_density, rc=rc) + + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compice), 'Sa_pbot', pressure, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compice), 'Sa_tbot', temperature, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1,size(temperature) @@ -202,16 +252,38 @@ subroutine med_phases_prep_ice(gcomp, rc) air_density(n) = 0._R8 endif end do + + else + call ESMF_LogWrite(trim(subname)//": air density to ice cannot be computed", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return end if + endif + + ! if Sa_ptem is not sent by the atm but is required by the ice + ! compute potential temperature as a custom calculation - + ! requires Sa_pbot, Sa_tbot from atm, will abort if it can't be calculated + if (.not. fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_ptem',rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compice) , 'Sa_ptem',rc=rc)) then + + if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_pbot',rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_tbot',rc=rc)) then - ! compute potential temperature as a custom calculation - - ! if Sa_ptem is not sent by the atm but is required by the ice - if (.not. fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_ptem',rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compice), 'Sa_ptem',rc=rc)) then call ESMF_LogWrite(trim(subname)//": computing potential temp as a custom calculation", ESMF_LOGMSG_INFO) + ! interpolate fields if not done as part of prep_ice + ! Sa_pbot and Sa_tbot done above so we should be all set + call FB_GetFldPtr(is_local%wrap%FBExp(compice), 'Sa_ptem', pot_temp, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compice), 'Sa_pbot', pressure, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compice), 'Sa_tbot', temperature, rc=rc) + if (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) @@ -219,8 +291,12 @@ subroutine med_phases_prep_ice(gcomp, rc) pot_temp(n) = 0._R8 end if end do - end if - + else + call ESMF_LogWrite(trim(subname)//": potential temperature to ice cannot be computed", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif end if if (dbug_flag > 1) then diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index d9e7e60ed..f8d140bad 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -9,7 +9,7 @@ module med_phases_prep_lnd_mod use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet use ESMF , only : ESMF_FieldBundleCreate, ESMF_FieldBundleAdd - use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated + use ESMF , only : ESMF_RouteHandle use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_StateGet, ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND use ESMF , only : ESMF_Mesh, ESMF_MeshLoc, ESMF_MESHLOC_ELEMENT @@ -29,7 +29,7 @@ module med_phases_prep_lnd_mod use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod , only : InternalState, logunit - use med_map_mod , only : med_map_FB_Regrid_Norm + use med_map_mod , only : med_map_FB_Regrid_Norm, med_map_RH_is_created use med_map_mod , only : med_map_Fractions_Init use med_merge_mod , only : med_merge_auto use glc_elevclass_mod , only : glc_get_num_elevation_classes @@ -309,7 +309,7 @@ subroutine med_map_glc2lnd_init(gcomp, rc) ! Create route handle if it has not been created ! ------------------------------- - if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(compglc,complnd,mapconsf))) then + if (.not. med_map_RH_is_created(is_local%wrap%RH(compglc,complnd,:),mapconsf,rc=rc)) then call med_map_Fractions_init( gcomp, compglc, complnd, & FBSrc=FBglc_ec, FBDst=FBlnd_ec, & RouteHandle=is_local%wrap%RH(compglc,complnd,mapconsf), rc=rc) diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 9e3356a8f..f314ded75 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -27,11 +27,11 @@ module med_phases_prep_rof_mod use med_methods_mod , only : FB_average => med_methods_FB_average use med_methods_mod , only : FB_reset => med_methods_FB_reset use med_methods_mod , only : FB_clean => med_methods_FB_clean - use med_methods_mod , only : FB_FieldRegrid => med_methods_FB_FieldRegrid use med_methods_mod , only : State_GetScalar => med_methods_State_GetScalar use med_methods_mod , only : State_SetScalar => med_methods_State_SetScalar use med_merge_mod , only : med_merge_auto - use med_map_mod , only : med_map_FB_Regrid_Norm + use med_map_mod , only : med_map_FB_Regrid_Norm, med_map_RH_is_created + use med_map_mod , only : med_map_FB_Field_Regrid use perf_mod , only : t_startf, t_stopf implicit none @@ -329,9 +329,9 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) ! (non-volr-normalized) flux on the rof grid. !--------------------------------------------------------------- - use ESMF , only : ESMF_GridComp, ESMF_Field, ESMF_FieldRegrid + use ESMF , only : ESMF_GridComp, ESMF_Field use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_FieldBundleIsCreated - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_RouteHandleIsCreated + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_LOGMSG_INFO, ESMF_LogWrite ! input/output variables @@ -368,13 +368,13 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) 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 + if (.not. med_map_RH_is_created(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 + if (.not. med_map_RH_is_created(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 @@ -448,8 +448,8 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) end do ! Map volr_r to volr_l (rof->lnd) using conservative mapping without any fractional weighting - call FB_FieldRegrid(FBrofVolr, trim(volr_field), FBlndVolr, trim(volr_field), & - is_local%wrap%RH(comprof, complnd, mapconsf), rc=rc) + call med_map_FB_Field_Regrid(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 From c8caaffaa09ea7c4e08065ddc77837ba65b3192d Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sun, 7 Jun 2020 14:33:45 -0600 Subject: [PATCH 06/32] update esmFldsExchange for frac grid --- mediator/esmFldsExchange_nems_mod.F90 | 25 +++++++++++++++++-------- mediator/med_constants_mod.F90 | 2 +- mediator/med_fraction_mod.F90 | 2 +- mediator/med_phases_prep_atm_mod.F90 | 4 ++-- 4 files changed, 21 insertions(+), 12 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 6f6863fdc..39098b922 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -75,7 +75,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! atm and ocn fields required for atm/ocn flux calculation' allocate(flds(6)) - flds = (/'Sa_u ','Sa_v ','Sa_z ','Sa_tbot','Sa_pbot','Sa_shum'/) + flds = (/'Sa_u ','Sa_v ', 'Sa_z ', 'Sa_tbot', 'Sa_pbot', 'Sa_shum'/) do n = 1,size(flds) fldname = trim(flds(n)) call addfld(fldListFr(compatm)%flds, trim(fldname)) @@ -127,7 +127,11 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) call addfld(fldListFr(compice)%flds, trim(fldname)) call addfld(fldListTo(compatm)%flds, trim(fldname)) - call addmap(fldListFr(compice)%flds, trim(fldname), compatm, mapnstod_consf, 'ifrac', 'unset') + if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then + call addmap(fldListFr(compice)%flds, trim(fldname), compatm, mapnstod_consf, 'ifrac', 'unset') + else + call addmap(fldListFr(compice)%flds, trim(fldname), compatm, mapconsf, 'ifrac', 'unset') + end if call addmrg(fldListTo(compatm)%flds, trim(fldname), mrg_from1=compice, mrg_fld1=trim(fldname), mrg_type1='copy') end do deallocate(flds) @@ -135,7 +139,11 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to atm: unmerged surface temperatures from ocn call addfld(fldListFr(compocn)%flds, 'So_t') call addfld(fldListTo(compatm)%flds, 'So_t') - call addmap(fldListFr(compocn)%flds, 'So_t', compatm, mapnstod_consf, 'ofrac', 'unset') + if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then + call addmap(fldListFr(compocn)%flds, 'So_t', compatm, mapnstod_consf, 'ofrac', 'unset') + else + call addmap(fldListFr(compocn)%flds, 'So_t', compatm, mapconsf, 'ofrac', 'unset') + end if call addmrg(fldListTo(compatm)%flds, 'So_t', mrg_from1=compocn, mrg_fld1='So_t', mrg_type1='copy') !===================================================================== @@ -296,11 +304,12 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapnstod_consf, 'none', 'unset') else - if (trim(fldname) == 'Sa_u' .or. trim(fldname) == 'Sa_v') then - call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mappatch, 'none', 'unset') - else - call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapbilnr, 'none', 'unset') - end if + ! if (trim(fldname) == 'Sa_u' .or. trim(fldname) == 'Sa_v') then + ! call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mappatch, 'none', 'unset') + ! else + ! call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapbilnr, 'none', 'unset') + ! end if + call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapconsf, 'none', 'unset') end if call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy') end do diff --git a/mediator/med_constants_mod.F90 b/mediator/med_constants_mod.F90 index 4cc96f4f7..fb4bf3afd 100644 --- a/mediator/med_constants_mod.F90 +++ b/mediator/med_constants_mod.F90 @@ -11,6 +11,6 @@ module med_constants_mod 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 + integer :: med_constants_dbug_flag = 50 end module med_constants_mod diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index af27e3d35..d4464f77a 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -719,7 +719,7 @@ subroutine med_fraction_set(gcomp, rc) ! set ifrac = Si_ifrac * Si_imask ifrac(:) = Si_ifrac(:) * Si_imask(:) - if (trim(coupling_mode) == 'nems_orig') then + if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then ofrac(:) = 1._r8 - ifrac(:) else ! set ofrac = Si_imask - ifrac diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index e1111f59b..1f5073e33 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -160,13 +160,13 @@ subroutine med_phases_prep_atm(gcomp, rc) FBMed1=is_local%wrap%FBMed_ocnalb_a, & FBMed2=is_local%wrap%FBMed_aoflux_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode) == 'nems_orig') then + else if (trim(coupling_mode) == 'nems_orig_data') 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, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode) == 'nems_frac') then + else if (trim(coupling_mode) == 'nems_frac' .or. 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), rc=rc) From 4b538261fcf3cfa0cc9863404c80119cf2956890 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sun, 7 Jun 2020 14:39:50 -0600 Subject: [PATCH 07/32] remove commented out code; add TODO in prep_atm --- mediator/esmFldsExchange_nems_mod.F90 | 5 ----- mediator/med_phases_prep_atm_mod.F90 | 1 + 2 files changed, 1 insertion(+), 5 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 39098b922..af6810b62 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -304,11 +304,6 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapnstod_consf, 'none', 'unset') else - ! if (trim(fldname) == 'Sa_u' .or. trim(fldname) == 'Sa_v') then - ! call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mappatch, 'none', 'unset') - ! else - ! call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapbilnr, 'none', 'unset') - ! end if call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapconsf, 'none', 'unset') end if call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy') diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 1f5073e33..b62a94fa8 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -160,6 +160,7 @@ subroutine med_phases_prep_atm(gcomp, rc) FBMed1=is_local%wrap%FBMed_ocnalb_a, & FBMed2=is_local%wrap%FBMed_aoflux_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + !TODO: should be removed; nems_orig_data does not have prep_atm phase else if (trim(coupling_mode) == 'nems_orig_data') then call med_merge_auto(trim(compname(compatm)), & is_local%wrap%FBExp(compatm), is_local%wrap%FBFrac(compatm), & From 0895485355b25ce2435df9dd7902457c4f7114ae Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 11 Jun 2020 13:21:44 -0600 Subject: [PATCH 08/32] remove bilinr method for Sa_pslv --- mediator/esmFldsExchange_nems_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index af6810b62..6ccc769b9 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -162,7 +162,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, mapnstod_consf, 'none', 'unset') else - call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, mapbilnr, 'none', 'unset') + call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, mapconsf, 'none', 'unset') end if call addmrg(fldListTo(compocn)%flds, 'Sa_pslv', mrg_from1=compatm, mrg_fld1='Sa_pslv', mrg_type1='copy') From 7e59a903c0d98679ebc17f5a4315bfb1111e11d0 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sat, 13 Jun 2020 08:44:56 -0600 Subject: [PATCH 09/32] minor cleanup coupling mode for nems --- mediator/esmFlds.F90 | 2 +- mediator/esmFldsExchange_nems_mod.F90 | 80 +++++++++++++-------------- mediator/med_fraction_mod.F90 | 5 +- mediator/med_map_mod.F90 | 2 +- mediator/med_phases_prep_atm_mod.F90 | 15 ++--- 5 files changed, 53 insertions(+), 51 deletions(-) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index 944f31b3d..a1094e24c 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -46,7 +46,7 @@ module esmflds ! Set coupling mode !----------------------------------------------- - character(len=10), public :: coupling_mode ! valid values are [cesm,nems_orig,nems_frac] + character(len=CS), public :: coupling_mode ! valid values are [cesm,nems_orig,nems_frac,nems_orig_data] !----------------------------------------------- ! PUblic methods diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 6ccc769b9..8d2b7c743 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -127,11 +127,11 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) call addfld(fldListFr(compice)%flds, trim(fldname)) call addfld(fldListTo(compatm)%flds, trim(fldname)) - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then + !if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then call addmap(fldListFr(compice)%flds, trim(fldname), compatm, mapnstod_consf, 'ifrac', 'unset') - else - call addmap(fldListFr(compice)%flds, trim(fldname), compatm, mapconsf, 'ifrac', 'unset') - end if + !else + ! call addmap(fldListFr(compice)%flds, trim(fldname), compatm, mapconsf, 'ifrac', 'unset') + !end if call addmrg(fldListTo(compatm)%flds, trim(fldname), mrg_from1=compice, mrg_fld1=trim(fldname), mrg_type1='copy') end do deallocate(flds) @@ -139,11 +139,11 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to atm: unmerged surface temperatures from ocn call addfld(fldListFr(compocn)%flds, 'So_t') call addfld(fldListTo(compatm)%flds, 'So_t') - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then + ! if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then call addmap(fldListFr(compocn)%flds, 'So_t', compatm, mapnstod_consf, 'ofrac', 'unset') - else - call addmap(fldListFr(compocn)%flds, 'So_t', compatm, mapconsf, 'ofrac', 'unset') - end if + !else + ! call addmap(fldListFr(compocn)%flds, 'So_t', compatm, mapconsf, 'ofrac', 'unset') + !end if call addmrg(fldListTo(compatm)%flds, 'So_t', mrg_from1=compocn, mrg_fld1='So_t', mrg_type1='copy') !===================================================================== @@ -159,11 +159,11 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ocn: sea level pressure from atm call addfld(fldListTo(compocn)%flds, 'Sa_pslv') call addfld(fldListFr(compatm)%flds, 'Sa_pslv') - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then + !if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, mapnstod_consf, 'none', 'unset') - else - call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, mapconsf, 'none', 'unset') - end if + !else + ! call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, mapconsf, 'none', 'unset') + !end if call addmrg(fldListTo(compocn)%flds, 'Sa_pslv', mrg_from1=compatm, mrg_fld1='Sa_pslv', mrg_type1='copy') ! to ocn: from atm (custom merge in med_phases_prep_ocn) @@ -182,52 +182,52 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) call addfld(fldListTo(compocn)%flds, trim(fldname)) call addfld(fldListFr(compatm)%flds, trim(fldname)) - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then + !if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, mapnstod_consf, 'none', 'unset') - else - call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, mapconsf, 'none', 'unset') - end if + !else + ! call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, mapconsf, 'none', 'unset') + !end if end do deallocate(flds) ! to ocn: merged sensible heat flux (custom merge in med_phases_prep_ocn) call addfld(fldListTo(compocn)%flds, 'Faxa_sen') call addfld(fldListFr(compatm)%flds, 'Faxa_sen') - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then + !if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then call addmap(fldListFr(compatm)%flds, 'Faxa_sen', compocn, mapnstod_consf, 'none', 'unset') - else - call addmap(fldListFr(compatm)%flds, 'Faxa_sen', compocn, mapconsf, 'none', 'unset') - end if + !else + ! call addmap(fldListFr(compatm)%flds, 'Faxa_sen', compocn, mapconsf, 'none', 'unset') + !end if ! to ocn: surface latent heat flux and evaporation water flux (custom merge in med_phases_prep_ocn) call addfld(fldListTo(compocn)%flds, 'Faxa_evap') call addfld(fldListFr(compatm)%flds, 'Faxa_lat') - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then + !if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then call addmap(fldListFr(compatm)%flds, 'Faxa_lat', compocn, mapnstod_consf, 'none', 'unset') - else - call addmap(fldListFr(compatm)%flds, 'Faxa_lat', compocn, mapconsf, 'none', 'unset') - end if + !else + ! call addmap(fldListFr(compatm)%flds, 'Faxa_lat', compocn, mapconsf, 'none', 'unset') + !end if ! to ocn: merge zonal surface stress (custom merge calculation in med_phases_prep_ocn) call addfld(fldListTo(compocn)%flds, 'Foxx_taux') call addfld(fldListFr(compice)%flds, 'Fioi_taux') call addfld(fldListFr(compatm)%flds, 'Faxa_taux') - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then + !if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then call addmap(fldListFr(compatm)%flds, 'Faxa_taux', compocn, mapnstod_consf, 'none', 'unset') - else - call addmap(fldListFr(compatm)%flds, 'Faxa_taux', compocn, mapconsf, 'none', 'unset') - end if + !else + ! call addmap(fldListFr(compatm)%flds, 'Faxa_taux', compocn, mapconsf, 'none', 'unset') + !end if call addmap(fldListFr(compice)%flds, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') ! to ocn: meridional surface stress (custom merge calculation in med_phases_prep_ocn) call addfld(fldListTo(compocn)%flds, 'Foxx_tauy') call addfld(fldListFr(compice)%flds, 'Fioi_tauy') call addfld(fldListFr(compatm)%flds, 'Faxa_tauy') - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then + !if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then call addmap(fldListFr(compatm)%flds, 'Faxa_tauy', compocn, mapnstod_consf, 'none', 'unset') - else - call addmap(fldListFr(compatm)%flds, 'Faxa_tauy', compocn, mapconsf, 'none', 'unset') - end if + !else + ! call addmap(fldListFr(compatm)%flds, 'Faxa_tauy', compocn, mapconsf, 'none', 'unset') + !end if call addmap(fldListFr(compice)%flds, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') ! to ocn: net shortwave radiation from med (custom merge in med_phases_prep_ocn) @@ -279,11 +279,11 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) call addfld(fldListFr(compatm)%flds, trim(fldname)) call addfld(fldListTo(compice)%flds, trim(fldname)) - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then + !if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapnstod_consf, 'none', 'unset') - else - call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapconsf, 'none', 'unset') - end if + !else + ! call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapconsf, 'none', 'unset') + !end if call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy') end do deallocate(flds) @@ -301,11 +301,11 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) call addfld(fldListTo(compice)%flds, trim(fldname)) call addfld(fldListFr(compatm)%flds, trim(fldname)) - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then + !if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapnstod_consf, 'none', 'unset') - else - call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapconsf, 'none', 'unset') - end if + !else + ! call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapconsf, 'none', 'unset') + !end if call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy') end do deallocate(flds) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index d4464f77a..47a590307 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -2,7 +2,7 @@ module med_fraction_mod !----------------------------------------------------------------------------- ! Mediator Component. - ! Sets fracations on all component grids + ! Sets fractions 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 @@ -753,7 +753,8 @@ subroutine med_fraction_set(gcomp, rc) ! ------------------------------------------- if (is_local%wrap%comp_present(compatm)) then - if (trim(coupling_mode) == 'nems_orig') then + !if (trim(coupling_mode) == 'nems_orig') then + if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then ! Map 'ifrac' from FBfrac(compice) to FBfrac(compatm) call FB_FieldRegrid(& diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index fb7cea4b5..4d6712e70 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -161,7 +161,7 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) srcMaskValue = ispval_mask if (n1 == compocn .or. n1 == compice) srcMaskValue = 0 if (n2 == compocn .or. n2 == compice) dstMaskValue = 0 - else if (coupling_mode(1:5) == 'nems_') then + else if (coupling_mode(1:4) == 'nems') then if (n1 == compatm .and. (n2 == compocn .or. n2 == compice)) then srcMaskValue = 1 dstMaskValue = 0 diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index b62a94fa8..9727cdd85 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -137,7 +137,8 @@ subroutine med_phases_prep_atm(gcomp, rc) !--------------------------------------- ! Assumption here is that fluxes are computed on the ocean grid - if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'nems_orig') then + !if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'nems_orig') then + if (trim(coupling_mode) == 'cesm' ) then call med_map_FB_Regrid_Norm(& fldsSrc=fldListMed_aoflux%flds, & srccomp=compocn, destcomp=compatm, & @@ -161,12 +162,12 @@ subroutine med_phases_prep_atm(gcomp, rc) FBMed2=is_local%wrap%FBMed_aoflux_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !TODO: should be removed; nems_orig_data does not have prep_atm phase - else if (trim(coupling_mode) == 'nems_orig_data') 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, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !else if (trim(coupling_mode) == 'nems_orig_data') 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, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'nems_frac' .or. trim(coupling_mode) == 'nems_orig') then call med_merge_auto(trim(compname(compatm)), & is_local%wrap%FBExp(compatm), is_local%wrap%FBFrac(compatm), & From a7f79b4924cc440c6ff3c944f41e2cfba9c3ac99 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 15 Jun 2020 05:50:39 -0600 Subject: [PATCH 10/32] fix Makefile,remove unneeded nems code in prep_atm --- mediator/Makefile | 2 +- mediator/med_phases_prep_atm_mod.F90 | 8 -------- 2 files changed, 1 insertion(+), 9 deletions(-) diff --git a/mediator/Makefile b/mediator/Makefile index 97d2e8048..95f8b17d0 100644 --- a/mediator/Makefile +++ b/mediator/Makefile @@ -31,7 +31,7 @@ med_kind_mod.o : med_constants_mod.o : med_kind_mod.o esmFlds.o : med_kind_mod.o esmFldsExchange_cesm_mod.o : med_kind_mod.o med_methods_mod.o esmFlds.o med_internalstate_mod.o med_utils_mod.o -eesmFldsExchange_nems_mod.o : med_kind_mod.o med_methods_mod.o esmFlds.o med_internalstate_mod.o med_utils_mod.o +esmFldsExchange_nems_mod.o : med_kind_mod.o med_methods_mod.o esmFlds.o med_internalstate_mod.o med_utils_mod.o med.o : med_kind_mod.o med_phases_profile_mod.o med_utils_mod.o med_phases_prep_rof_mod.o med_phases_aofluxes_mod.o \ med_phases_prep_ice_mod.o med_fraction_mod.o med_map_mod.o med_constants_mod.o med_phases_prep_wav_mod.o \ med_phases_prep_lnd_mod.o med_phases_history_mod.o med_phases_ocnalb_mod.o med_phases_restart_mod.o \ diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 9727cdd85..ab9f3d3f9 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -137,7 +137,6 @@ subroutine med_phases_prep_atm(gcomp, rc) !--------------------------------------- ! Assumption here is that fluxes are computed on the ocean grid - !if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'nems_orig') then if (trim(coupling_mode) == 'cesm' ) then call med_map_FB_Regrid_Norm(& fldsSrc=fldListMed_aoflux%flds, & @@ -161,13 +160,6 @@ subroutine med_phases_prep_atm(gcomp, rc) FBMed1=is_local%wrap%FBMed_ocnalb_a, & FBMed2=is_local%wrap%FBMed_aoflux_a, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !TODO: should be removed; nems_orig_data does not have prep_atm phase - !else if (trim(coupling_mode) == 'nems_orig_data') 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, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'nems_frac' .or. trim(coupling_mode) == 'nems_orig') then call med_merge_auto(trim(compname(compatm)), & is_local%wrap%FBExp(compatm), is_local%wrap%FBFrac(compatm), & From d6a1ea48802665a952878779b0ab5d24b6e7e509 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 17 Jun 2020 14:54:46 -0600 Subject: [PATCH 11/32] add two small fixes from datm branch --- mediator/med_merge_mod.F90 | 2 +- mediator/med_phases_prep_ocn_mod.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med_merge_mod.F90 b/mediator/med_merge_mod.F90 index 3fa8daf17..c0bf98c9c 100644 --- a/mediator/med_merge_mod.F90 +++ b/mediator/med_merge_mod.F90 @@ -287,7 +287,7 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then write(msg,*)trim(subname),'input field ',trim(FBfld),' has rank ',lrank_input - call ESMF_LogWrite(msg, ESMF_LOGMSG_ERROR) + call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO) end if if (lrank_input == 1) then diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index c6f2ac88f..669172a15 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -551,7 +551,7 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_sen', & FBinA=is_local%wrap%FBMed_aoflux_o , fnameA='Faox_sen ', wgtA=ocnwgt1, & - FBinC=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_sen' , wgtB=wgtm01, rc=rc) + FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_sen' , wgtB=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, & From 0255a580c3aee5d1db21d566f111a87acc88e0ea Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 18 Jun 2020 10:04:12 -0600 Subject: [PATCH 12/32] changes for si_ifrac --- mediator/esmFldsExchange_nems_mod.F90 | 12 +- mediator/med.F90 | 254 ++++++++++++++------------ mediator/med_fraction_mod.F90 | 1 + mediator/med_phases_prep_atm_mod.F90 | 56 +++--- 4 files changed, 175 insertions(+), 148 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 8d2b7c743..b3d2d8d1a 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -107,9 +107,11 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) !===================================================================== ! to atm: fractions (computed in med_phases_prep_atm) + call addfld(fldListFr(compice)%flds, 'Si_ifrac') call addfld(fldListTo(compatm)%flds, 'Si_ifrac') - call addfld(fldListTo(compatm)%flds, 'So_ofrac') - + call addmap(fldListFr(compice)%flds, 'Si_ifrac', compatm, mapnstod_consf, 'none', 'unset') + call addmrg(fldListTo(compatm)%flds, 'Si_ifrac', mrg_from1=compice, mrg_fld1='Si_ifrac', mrg_type1='copy') + ! to atm: unmerged from ice ! - zonal surface stress, meridional surface stress ! - surface latent heat flux, @@ -150,12 +152,6 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! FIELDS TO OCEAN (compocn) !===================================================================== - ! to ocn: fractional ice coverage wrt ocean from ice - call addfld(fldListFr(compice)%flds, 'Si_ifrac') - call addfld(fldListTo(compocn)%flds, 'Si_ifrac') - 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') - ! to ocn: sea level pressure from atm call addfld(fldListTo(compocn)%flds, 'Sa_pslv') call addfld(fldListFr(compatm)%flds, 'Sa_pslv') diff --git a/mediator/med.F90 b/mediator/med.F90 index 3e3637529..6faa315d7 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -412,7 +412,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) mastertask = .false. if (localPet == 0) mastertask=.true. - ! Determine mediator logunit + ! Determine mediator logunit if (mastertask) then call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1489,7 +1489,6 @@ subroutine DataInitialize(gcomp, rc) ! local variables type(InternalState) :: is_local - type(ESMF_VM) :: vm type(ESMF_Clock) :: clock type(ESMF_State) :: importState, exportState type(ESMF_Time) :: time @@ -1653,7 +1652,7 @@ subroutine DataInitialize(gcomp, rc) ! Create import accumulation field bundles call FB_init(is_local%wrap%FBImpAccum(n1,n1), is_local%wrap%flds_scalar_name, & STgeom=is_local%wrap%NStateImp(n1), STflds=is_local%wrap%NStateImp(n1), & - name='FBImp'//trim(compname(n1)), rc=rc) + name='FBImpAccum'//trim(compname(n1)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_reset(is_local%wrap%FBImpAccum(n1,n1), value=czero, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1804,54 +1803,6 @@ subroutine DataInitialize(gcomp, rc) endif ! end first_call if-block - !--------------------------------------- - ! Initialize mediator fields and infodata - ! This is called every loop around DataInitialize - !--------------------------------------- - - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - 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 (ChkErr(rc,__LINE__,u_FILE_u)) return - - allocate(fieldNameList(fieldCount)) - call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemNameList=fieldNameList, rc=rc) - if (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 (ChkErr(rc,__LINE__,u_FILE_u)) return - - atCorrectTime = NUOPC_IsAtTime(field, time, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (atCorrectTime) then - if (fieldNameList(n) == is_local%wrap%flds_scalar_name) then - call ESMF_LogWrite(trim(subname)//" MED - Initialize-Data-Dependency CSTI "//trim(compname(n1)), & - ESMF_LOGMSG_INFO, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif - else - LocalDone=.false. - endif - enddo - deallocate(fieldNameList) - - if (LocalDone) then - call ESMF_LogWrite(trim(subname)//" MED - Initialize-Data-Dependency Copy Import "//& - trim(compname(n1)), ESMF_LOGMSG_INFO, rc=rc) - if (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 @@ -1864,26 +1815,19 @@ subroutine DataInitialize(gcomp, rc) call med_fraction_set(gcomp,rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compatm)) then - call med_phases_ocnalb_run(gcomp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - !--------------------------------------- - ! Carry out data dependency for atm initialization if needed + ! Carry out data dependency for initialization for NEMS !--------------------------------------- - if (.not. is_local%wrap%comp_present(compocn)) ocnDone = .true. - if (.not. is_local%wrap%comp_present(compatm)) atmDone = .true. + if (trim(coupling_mode(1:4)) == 'nems') then - 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 + ! check that all imported fields from ATM show correct timestamp call ESMF_StateGet(is_local%wrap%NStateImp(compatm), itemCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(fieldNameList(fieldCount)) call ESMF_StateGet(is_local%wrap%NStateImp(compatm), itemNameList=fieldNameList, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + allDone = .true. do n=1, fieldCount call ESMF_StateGet(is_local%wrap%NStateImp(compatm), itemName=fieldNameList(n), field=field, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1899,68 +1843,168 @@ subroutine DataInitialize(gcomp, rc) enddo deallocate(fieldNameList) - if (.not. atmdone) then ! atmdone is not true - ! do the merge to the atmospheric component - call med_phases_prep_atm(gcomp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! TOOD: this duplciates NEMS - but should the check be over all components - and not just atm - ! change 'Updated' attribute to true for ALL exportState fields - call ESMF_StateGet(is_local%wrap%NStateExp(compatm), itemCount=fieldCount, rc=rc) + if (allDone) then + ! set InitializeDataComplete Component Attribute to "true", indicating + ! to the driver that this Component has fully initialized its data + call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(fieldNameList(fieldCount)) - call ESMF_StateGet(is_local%wrap%NStateExp(compatm), itemNameList=fieldNameList, rc=rc) + call ESMF_LogWrite("MED - Initialize-Data-Dependency allDone check Passed", ESMF_LOGMSG_INFO, rc=rc) if (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) + else + call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) + if (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 (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + end if + + !--------------------------------------- + ! Carry out data dependency for initialization for CESM + !--------------------------------------- + + if (trim(coupling_mode) == 'cesm') then + + 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 (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_SetAttribute(field, name="Updated", value="true", rc=rc) + allocate(fieldNameList(fieldCount)) + call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemNameList=fieldNameList, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - deallocate(fieldNameList) + do n=1, fieldCount + call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemName=fieldNameList(n), field=field, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + atCorrectTime = NUOPC_IsAtTime(field, time, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (atCorrectTime) then + if (fieldNameList(n) == is_local%wrap%flds_scalar_name) then + call ESMF_LogWrite(trim(subname)//" MED - Initialize-Data-Dependency CSTI "//trim(compname(n1)), & + ESMF_LOGMSG_INFO, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + else + LocalDone=.false. + endif + enddo + deallocate(fieldNameList) + + if (LocalDone) then + call ESMF_LogWrite(trim(subname)//" MED - Initialize-Data-Dependency Copy Import "//& + trim(compname(n1)), ESMF_LOGMSG_INFO, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (n1 == compocn) ocnDone = .true. + if (n1 == compatm) atmDone = .true. + endif + endif + enddo - ! 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 (ChkErr(rc,__LINE__,u_FILE_u)) return - endif - endif + ! If ocn component is not present set ocnDone to true + if (.not. is_local%wrap%comp_present(compocn)) ocnDone = .true. - allDone = .true. - do n1 = 1,ncomps - if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then + ! If atm component is not present set ocnDone to true + if (.not. is_local%wrap%comp_present(compatm)) atmDone = .true. - call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemCount=fieldCount, rc=rc) + if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compatm)) then + call med_phases_ocnalb_run(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + 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 (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(fieldNameList(fieldCount)) - call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemNameList=fieldNameList, rc=rc) + call ESMF_StateGet(is_local%wrap%NStateImp(compatm), itemNameList=fieldNameList, rc=rc) if (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) + call ESMF_StateGet(is_local%wrap%NStateImp(compatm), itemName=fieldNameList(n), field=field, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return atCorrectTime = NUOPC_IsAtTime(field, time, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (.not. atCorrectTime) then - allDone=.false. + ! 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 (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 + ! do the merge to the atmospheric component + call med_phases_prep_atm(gcomp, rc=rc) + if (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 (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(fieldNameList(fieldCount)) + call ESMF_StateGet(is_local%wrap%NStateExp(compatm), itemNameList=fieldNameList, rc=rc) + if (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 (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_SetAttribute(field, name="Updated", value="true", rc=rc) + if (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 (ChkErr(rc,__LINE__,u_FILE_u)) return + endif endif - enddo + ! Determine if allDone is true + allDone = .true. + do n1 = 1,ncomps + if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then - ! set InitializeDataComplete Component Attribute to "true", indicating - ! to the driver that this Component has fully initialized its data + call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemCount=fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(fieldNameList(fieldCount)) + call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemNameList=fieldNameList, rc=rc) + if (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 (ChkErr(rc,__LINE__,u_FILE_u)) return + atCorrectTime = NUOPC_IsAtTime(field, time, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (.not. atCorrectTime) then + allDone=.false. + endif + enddo + deallocate(fieldNameList) + endif + enddo - if (allDone) then - call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (allDone) then + ! set InitializeDataComplete Component Attribute to "true", indicating + ! to the driver that this Component has fully initialized its data + call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite("MED - Initialize-Data-Dependency allDone check Passed", ESMF_LOGMSG_INFO, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) + if (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 (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - call ESMF_LogWrite("MED - Initialize-Data-Dependency allDone check Passed", ESMF_LOGMSG_INFO, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - !--------------------------------------- - ! Create component dimensions in mediator internal state - !--------------------------------------- + !--------------------------------------- + ! Data dependency is successfully completed + !--------------------------------------- + if (allDone) then + ! Create component dimensions in mediator internal state if (mastertask) write(logunit,*) do n1 = 1,ncomps if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then @@ -1985,34 +2029,20 @@ subroutine DataInitialize(gcomp, rc) end do if (mastertask) write(logunit,*) - !--------------------------------------- ! Initialize mediator IO - !--------------------------------------- - call med_io_init() - !--------------------------------------- ! read mediator restarts - !--------------------------------------- - call NUOPC_CompAttributeGet(gcomp, name="read_restart", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//' read_restart = '//trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) read_restart - if (read_restart) then call med_phases_restart_read(gcomp, rc) if (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 (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 (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 47a590307..d01851852 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -718,6 +718,7 @@ subroutine med_fraction_set(gcomp, rc) ! set ifrac = Si_ifrac * Si_imask ifrac(:) = Si_ifrac(:) * Si_imask(:) + !ifrac(:) = Si_ifrac(:) if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then ofrac(:) = 1._r8 - ifrac(:) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index ab9f3d3f9..a744ae9db 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -177,34 +177,34 @@ subroutine med_phases_prep_atm(gcomp, rc) !--- custom calculations !--------------------------------------- - ! set fractions to send back to atm - if (FB_FldChk(is_local%wrap%FBExp(compatm), 'So_ofrac', rc=rc)) then - call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'So_ofrac', dataptr1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBFrac(compatm), 'ofrac', dataptr2, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(dataptr1) - dataptr1(n) = dataptr2(n) - end do - end if - if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Si_ifrac', rc=rc)) then - call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Si_ifrac', dataptr1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBFrac(compatm), 'ifrac', dataptr2, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(dataptr1) - dataptr1(n) = dataptr2(n) - end do - end if - if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Sl_lfrac', rc=rc)) then - call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Sl_lfrac', dataptr1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBFrac(compatm), 'lfrac', dataptr2, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(dataptr1) - dataptr1(n) = dataptr2(n) - end do - end if + ! ! set fractions to send back to atm + ! if (FB_FldChk(is_local%wrap%FBExp(compatm), 'So_ofrac', rc=rc)) then + ! call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'So_ofrac', dataptr1, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call FB_GetFldPtr(is_local%wrap%FBFrac(compatm), 'ofrac', dataptr2, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! do n = 1,size(dataptr1) + ! dataptr1(n) = dataptr2(n) + ! end do + ! end if + ! if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Si_ifrac', rc=rc)) then + ! call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Si_ifrac', dataptr1, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call FB_GetFldPtr(is_local%wrap%FBFrac(compatm), 'ifrac', dataptr2, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! do n = 1,size(dataptr1) + ! dataptr1(n) = dataptr2(n) + ! end do + ! end if + ! if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Sl_lfrac', rc=rc)) then + ! call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Sl_lfrac', dataptr1, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call FB_GetFldPtr(is_local%wrap%FBFrac(compatm), 'lfrac', dataptr2, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! do n = 1,size(dataptr1) + ! dataptr1(n) = dataptr2(n) + ! end do + ! end if !--------------------------------------- !--- update local scalar data From 22e1b2651cc9394456c6108ebf574d0b33dcdf2c Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 23 Jun 2020 10:05:01 -0600 Subject: [PATCH 13/32] add ability to read dbug_flag from nems.configure MED_attributes --- mediator/med.F90 | 14 +++++++++----- mediator/med_constants_mod.F90 | 2 +- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 6faa315d7..de12bb474 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -394,7 +394,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) ! local variables type(ESMF_VM) :: vm - character(len=CL) :: value + character(len=CL) :: cvalue integer :: localPet logical :: isPresent, isSet character(len=CX) :: msgString @@ -429,14 +429,18 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) logUnit = 6 endif - call ESMF_AttributeGet(gcomp, name="Verbosity", value=value, defaultValue="max", & + call ESMF_AttributeGet(gcomp, name="Verbosity", value=cvalue, defaultValue="max", & convention="NUOPC", purpose="Instance", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": Mediator verbosity is "//trim(value), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": Mediator verbosity is "//trim(cvalue), ESMF_LOGMSG_INFO) - write(msgString,'(A,i6)') trim(subname)//' dbug_flag = ',dbug_flag + call NUOPC_CompAttributeGet(gcomp, name='dbug_flag', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) dbug_flag + end if + write(msgString,'(A,i6)') trim(subname)//': Mediator dbug_flag is ',dbug_flag call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) ! Switch to IPDv03 by filtering all other phaseMap entries call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, acceptStringList=(/"IPDv03p"/), rc=rc) diff --git a/mediator/med_constants_mod.F90 b/mediator/med_constants_mod.F90 index fb4bf3afd..4cc96f4f7 100644 --- a/mediator/med_constants_mod.F90 +++ b/mediator/med_constants_mod.F90 @@ -11,6 +11,6 @@ module med_constants_mod 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 = 50 + integer :: med_constants_dbug_flag = 0 end module med_constants_mod From 713fe368a154bd36f0d9cdffaa882ed7ac53483b Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 23 Jun 2020 10:25:20 -0600 Subject: [PATCH 14/32] introduce mapping_mode mapping_mode is set according to coupling mode --- mediator/esmFldsExchange_nems_mod.F90 | 71 +++++++-------------------- 1 file changed, 19 insertions(+), 52 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index b3d2d8d1a..b4947bd21 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -41,7 +41,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) integer , intent(inout) :: rc ! local variables: - integer :: i, n + integer :: i, n, mapping_mode character(len=CL) :: cvalue character(len=CS) :: fldname character(len=CS), allocatable :: flds(:) @@ -53,6 +53,13 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! Initialize if use 3d cartesian mapping for u,v mapuv_with_cart3d = .false. + ! Set mapping_mode according to coupling_mode + if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then + mapping_mode = mapnstod_consf + else + mapping_mode = mapconsf + end if + !===================================================================== ! scalar information !===================================================================== @@ -109,7 +116,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to atm: fractions (computed in med_phases_prep_atm) call addfld(fldListFr(compice)%flds, 'Si_ifrac') call addfld(fldListTo(compatm)%flds, 'Si_ifrac') - call addmap(fldListFr(compice)%flds, 'Si_ifrac', compatm, mapnstod_consf, 'none', 'unset') + call addmap(fldListFr(compice)%flds, 'Si_ifrac', compatm, mapping_mode, 'none', 'unset') call addmrg(fldListTo(compatm)%flds, 'Si_ifrac', mrg_from1=compice, mrg_fld1='Si_ifrac', mrg_type1='copy') ! to atm: unmerged from ice @@ -129,11 +136,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) call addfld(fldListFr(compice)%flds, trim(fldname)) call addfld(fldListTo(compatm)%flds, trim(fldname)) - !if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then - call addmap(fldListFr(compice)%flds, trim(fldname), compatm, mapnstod_consf, 'ifrac', 'unset') - !else - ! call addmap(fldListFr(compice)%flds, trim(fldname), compatm, mapconsf, 'ifrac', 'unset') - !end if + call addmap(fldListFr(compice)%flds, trim(fldname), compatm, mapping_mode, 'ifrac', 'unset') call addmrg(fldListTo(compatm)%flds, trim(fldname), mrg_from1=compice, mrg_fld1=trim(fldname), mrg_type1='copy') end do deallocate(flds) @@ -141,11 +144,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to atm: unmerged surface temperatures from ocn call addfld(fldListFr(compocn)%flds, 'So_t') call addfld(fldListTo(compatm)%flds, 'So_t') - ! if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then - call addmap(fldListFr(compocn)%flds, 'So_t', compatm, mapnstod_consf, 'ofrac', 'unset') - !else - ! call addmap(fldListFr(compocn)%flds, 'So_t', compatm, mapconsf, 'ofrac', 'unset') - !end if + call addmap(fldListFr(compocn)%flds, 'So_t', compatm, mapping_mode, 'ofrac', 'unset') call addmrg(fldListTo(compatm)%flds, 'So_t', mrg_from1=compocn, mrg_fld1='So_t', mrg_type1='copy') !===================================================================== @@ -155,11 +154,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ocn: sea level pressure from atm call addfld(fldListTo(compocn)%flds, 'Sa_pslv') call addfld(fldListFr(compatm)%flds, 'Sa_pslv') - !if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then - call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, mapnstod_consf, 'none', 'unset') - !else - ! call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, mapconsf, 'none', 'unset') - !end if + call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, mapping_mode, 'none', 'unset') call addmrg(fldListTo(compocn)%flds, 'Sa_pslv', mrg_from1=compatm, mrg_fld1='Sa_pslv', mrg_type1='copy') ! to ocn: from atm (custom merge in med_phases_prep_ocn) @@ -178,52 +173,32 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) call addfld(fldListTo(compocn)%flds, trim(fldname)) call addfld(fldListFr(compatm)%flds, trim(fldname)) - !if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then - call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, mapnstod_consf, 'none', 'unset') - !else - ! call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, mapconsf, 'none', 'unset') - !end if + call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, mapping_mode, 'none', 'unset') end do deallocate(flds) ! to ocn: merged sensible heat flux (custom merge in med_phases_prep_ocn) call addfld(fldListTo(compocn)%flds, 'Faxa_sen') call addfld(fldListFr(compatm)%flds, 'Faxa_sen') - !if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then - call addmap(fldListFr(compatm)%flds, 'Faxa_sen', compocn, mapnstod_consf, 'none', 'unset') - !else - ! call addmap(fldListFr(compatm)%flds, 'Faxa_sen', compocn, mapconsf, 'none', 'unset') - !end if + call addmap(fldListFr(compatm)%flds, 'Faxa_sen', compocn, mapping_mode, 'none', 'unset') ! to ocn: surface latent heat flux and evaporation water flux (custom merge in med_phases_prep_ocn) call addfld(fldListTo(compocn)%flds, 'Faxa_evap') call addfld(fldListFr(compatm)%flds, 'Faxa_lat') - !if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then - call addmap(fldListFr(compatm)%flds, 'Faxa_lat', compocn, mapnstod_consf, 'none', 'unset') - !else - ! call addmap(fldListFr(compatm)%flds, 'Faxa_lat', compocn, mapconsf, 'none', 'unset') - !end if + call addmap(fldListFr(compatm)%flds, 'Faxa_lat', compocn, mapping_mode, 'none', 'unset') ! to ocn: merge zonal surface stress (custom merge calculation in med_phases_prep_ocn) call addfld(fldListTo(compocn)%flds, 'Foxx_taux') call addfld(fldListFr(compice)%flds, 'Fioi_taux') call addfld(fldListFr(compatm)%flds, 'Faxa_taux') - !if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then - call addmap(fldListFr(compatm)%flds, 'Faxa_taux', compocn, mapnstod_consf, 'none', 'unset') - !else - ! call addmap(fldListFr(compatm)%flds, 'Faxa_taux', compocn, mapconsf, 'none', 'unset') - !end if + call addmap(fldListFr(compatm)%flds, 'Faxa_taux', compocn, mapping_mode, 'none', 'unset') call addmap(fldListFr(compice)%flds, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') ! to ocn: meridional surface stress (custom merge calculation in med_phases_prep_ocn) call addfld(fldListTo(compocn)%flds, 'Foxx_tauy') call addfld(fldListFr(compice)%flds, 'Fioi_tauy') call addfld(fldListFr(compatm)%flds, 'Faxa_tauy') - !if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then - call addmap(fldListFr(compatm)%flds, 'Faxa_tauy', compocn, mapnstod_consf, 'none', 'unset') - !else - ! call addmap(fldListFr(compatm)%flds, 'Faxa_tauy', compocn, mapconsf, 'none', 'unset') - !end if + call addmap(fldListFr(compatm)%flds, 'Faxa_tauy', compocn, mapping_mode, 'none', 'unset') call addmap(fldListFr(compice)%flds, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') ! to ocn: net shortwave radiation from med (custom merge in med_phases_prep_ocn) @@ -275,11 +250,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) call addfld(fldListFr(compatm)%flds, trim(fldname)) call addfld(fldListTo(compice)%flds, trim(fldname)) - !if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then - call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapnstod_consf, 'none', 'unset') - !else - ! call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapconsf, 'none', 'unset') - !end if + call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapping_mode, 'none', 'unset') call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy') end do deallocate(flds) @@ -297,11 +268,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) call addfld(fldListTo(compice)%flds, trim(fldname)) call addfld(fldListFr(compatm)%flds, trim(fldname)) - !if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then - call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapnstod_consf, 'none', 'unset') - !else - ! call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapconsf, 'none', 'unset') - !end if + call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapping_mode, 'none', 'unset') call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy') end do deallocate(flds) From fe57ceb84b44043f4cd9ef7cd18a553021cc78f0 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 23 Jun 2020 12:37:43 -0600 Subject: [PATCH 15/32] add comments --- mediator/med.F90 | 2 ++ mediator/med_map_mod.F90 | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 533098479..f78e501d9 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -430,11 +430,13 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) logUnit = 6 endif + ! Obtain Verbosity setting from MED_attributes call ESMF_AttributeGet(gcomp, name="Verbosity", value=cvalue, defaultValue="max", & convention="NUOPC", purpose="Instance", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//": Mediator verbosity is "//trim(cvalue), ESMF_LOGMSG_INFO) + ! Obtain dbug_flag setting from MED_attributes if present; otherwise use default value in med_constants call NUOPC_CompAttributeGet(gcomp, name='dbug_flag', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index f23c6a20f..ec60b5f3e 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -572,7 +572,7 @@ subroutine med_map_MapNorm_init(gcomp, llogunit, rc) 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), & + //compname(n1)//'->'//compname(n2)//' with mapping '//mapnames(m), & ESMF_LOGMSG_INFO) endif call FB_init(FBout=is_local%wrap%FBNormOne(n1,n2,m), & From 9250cd5b9e61d58981eaf2312982950a23d58455 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 23 Jun 2020 17:00:02 -0600 Subject: [PATCH 16/32] rename mapping_mode to maptype for consistency add mapconf to FBFrac mapping for nems_frac --- mediator/esmFldsExchange_nems_mod.F90 | 37 +++++++++++++++------------ mediator/med_fraction_mod.F90 | 19 ++++++++++++-- 2 files changed, 37 insertions(+), 19 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index b4947bd21..9c862a84e 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -31,7 +31,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use esmflds , only : compmed, compatm, compocn, compice, comprof, ncomps use esmflds , only : mapbilnr, mapconsf, mapconsd, mappatch use esmflds , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf - use esmflds , only : coupling_mode, mapuv_with_cart3d + use esmflds , only : coupling_mode, mapuv_with_cart3d, mapnames use esmflds , only : fldListTo, fldListFr, fldListMed_aoflux, fldListMed_ocnalb use med_internalstate_mod , only : mastertask, logunit @@ -41,7 +41,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) integer , intent(inout) :: rc ! local variables: - integer :: i, n, mapping_mode + integer :: i, n, maptype + character(len=CX) :: msgString character(len=CL) :: cvalue character(len=CS) :: fldname character(len=CS), allocatable :: flds(:) @@ -53,12 +54,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! Initialize if use 3d cartesian mapping for u,v mapuv_with_cart3d = .false. - ! Set mapping_mode according to coupling_mode + ! Set maptype according to coupling_mode if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then - mapping_mode = mapnstod_consf + maptype = mapnstod_consf else - mapping_mode = mapconsf + maptype = mapconsf end if + write(msgString,'(A,i6,A)') trim(subname)//': maptype is ',maptype,', '//mapnames(maptype) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) !===================================================================== ! scalar information @@ -86,7 +89,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) do n = 1,size(flds) fldname = trim(flds(n)) call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, mapnstod_consf, 'none', 'unset') + call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, maptype, 'none', 'unset') end do deallocate(flds) @@ -116,7 +119,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to atm: fractions (computed in med_phases_prep_atm) call addfld(fldListFr(compice)%flds, 'Si_ifrac') call addfld(fldListTo(compatm)%flds, 'Si_ifrac') - call addmap(fldListFr(compice)%flds, 'Si_ifrac', compatm, mapping_mode, 'none', 'unset') + call addmap(fldListFr(compice)%flds, 'Si_ifrac', compatm, maptype, 'none', 'unset') call addmrg(fldListTo(compatm)%flds, 'Si_ifrac', mrg_from1=compice, mrg_fld1='Si_ifrac', mrg_type1='copy') ! to atm: unmerged from ice @@ -136,7 +139,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) call addfld(fldListFr(compice)%flds, trim(fldname)) call addfld(fldListTo(compatm)%flds, trim(fldname)) - call addmap(fldListFr(compice)%flds, trim(fldname), compatm, mapping_mode, 'ifrac', 'unset') + call addmap(fldListFr(compice)%flds, trim(fldname), compatm, maptype, 'ifrac', 'unset') call addmrg(fldListTo(compatm)%flds, trim(fldname), mrg_from1=compice, mrg_fld1=trim(fldname), mrg_type1='copy') end do deallocate(flds) @@ -144,7 +147,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to atm: unmerged surface temperatures from ocn call addfld(fldListFr(compocn)%flds, 'So_t') call addfld(fldListTo(compatm)%flds, 'So_t') - call addmap(fldListFr(compocn)%flds, 'So_t', compatm, mapping_mode, 'ofrac', 'unset') + call addmap(fldListFr(compocn)%flds, 'So_t', compatm, maptype, 'ofrac', 'unset') call addmrg(fldListTo(compatm)%flds, 'So_t', mrg_from1=compocn, mrg_fld1='So_t', mrg_type1='copy') !===================================================================== @@ -154,7 +157,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ocn: sea level pressure from atm call addfld(fldListTo(compocn)%flds, 'Sa_pslv') call addfld(fldListFr(compatm)%flds, 'Sa_pslv') - call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, mapping_mode, 'none', 'unset') + call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, maptype, 'none', 'unset') call addmrg(fldListTo(compocn)%flds, 'Sa_pslv', mrg_from1=compatm, mrg_fld1='Sa_pslv', mrg_type1='copy') ! to ocn: from atm (custom merge in med_phases_prep_ocn) @@ -173,32 +176,32 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) call addfld(fldListTo(compocn)%flds, trim(fldname)) call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, mapping_mode, 'none', 'unset') + call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, maptype, 'none', 'unset') end do deallocate(flds) ! to ocn: merged sensible heat flux (custom merge in med_phases_prep_ocn) call addfld(fldListTo(compocn)%flds, 'Faxa_sen') call addfld(fldListFr(compatm)%flds, 'Faxa_sen') - call addmap(fldListFr(compatm)%flds, 'Faxa_sen', compocn, mapping_mode, 'none', 'unset') + call addmap(fldListFr(compatm)%flds, 'Faxa_sen', compocn, maptype, 'none', 'unset') ! to ocn: surface latent heat flux and evaporation water flux (custom merge in med_phases_prep_ocn) call addfld(fldListTo(compocn)%flds, 'Faxa_evap') call addfld(fldListFr(compatm)%flds, 'Faxa_lat') - call addmap(fldListFr(compatm)%flds, 'Faxa_lat', compocn, mapping_mode, 'none', 'unset') + call addmap(fldListFr(compatm)%flds, 'Faxa_lat', compocn, maptype, 'none', 'unset') ! to ocn: merge zonal surface stress (custom merge calculation in med_phases_prep_ocn) call addfld(fldListTo(compocn)%flds, 'Foxx_taux') call addfld(fldListFr(compice)%flds, 'Fioi_taux') call addfld(fldListFr(compatm)%flds, 'Faxa_taux') - call addmap(fldListFr(compatm)%flds, 'Faxa_taux', compocn, mapping_mode, 'none', 'unset') + call addmap(fldListFr(compatm)%flds, 'Faxa_taux', compocn, maptype, 'none', 'unset') call addmap(fldListFr(compice)%flds, 'Fioi_taux', compocn, mapfcopy, 'unset', 'unset') ! to ocn: meridional surface stress (custom merge calculation in med_phases_prep_ocn) call addfld(fldListTo(compocn)%flds, 'Foxx_tauy') call addfld(fldListFr(compice)%flds, 'Fioi_tauy') call addfld(fldListFr(compatm)%flds, 'Faxa_tauy') - call addmap(fldListFr(compatm)%flds, 'Faxa_tauy', compocn, mapping_mode, 'none', 'unset') + call addmap(fldListFr(compatm)%flds, 'Faxa_tauy', compocn, maptype, 'none', 'unset') call addmap(fldListFr(compice)%flds, 'Fioi_tauy', compocn, mapfcopy, 'unset', 'unset') ! to ocn: net shortwave radiation from med (custom merge in med_phases_prep_ocn) @@ -250,7 +253,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) call addfld(fldListFr(compatm)%flds, trim(fldname)) call addfld(fldListTo(compice)%flds, trim(fldname)) - call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapping_mode, 'none', 'unset') + call addmap(fldListFr(compatm)%flds, trim(fldname), compice, maptype, 'none', 'unset') call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy') end do deallocate(flds) @@ -268,7 +271,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) call addfld(fldListTo(compice)%flds, trim(fldname)) call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapping_mode, 'none', 'unset') + call addmap(fldListFr(compatm)%flds, trim(fldname), compice, maptype, 'none', 'unset') call addmrg(fldListTo(compice)%flds, trim(fldname), mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy') end do deallocate(flds) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index d01851852..54f9102b8 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -754,8 +754,7 @@ subroutine med_fraction_set(gcomp, rc) ! ------------------------------------------- if (is_local%wrap%comp_present(compatm)) then - !if (trim(coupling_mode) == 'nems_orig') then - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then + if (trim(coupling_mode) == 'nems_orig') then ! Map 'ifrac' from FBfrac(compice) to FBfrac(compatm) call FB_FieldRegrid(& @@ -787,6 +786,22 @@ subroutine med_fraction_set(gcomp, rc) ofrac(:) = 1.0_R8 - ifrac(:) lfrac(:) = 0.0_R8 + else if (trim(coupling_mode) == 'nems_frac') then + + call FB_FieldRegrid(& + is_local%wrap%FBfrac(compice), 'ifrac', & + is_local%wrap%FBfrac(compatm), 'ifrac', & + is_local%wrap%RH(compice,compatm,:),mapconsf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine ofrac and lfrac on atm grid - set ofrac=1-ifrac and lfrac=0 + call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ofrac(:) = 1.0_R8 - ifrac(:) + lfrac(:) = 0.0_R8 + else if (med_map_RH_is_created(is_local%wrap%RH(compice,compatm,:),mapfcopy, rc=rc)) then From 04a37472e808138870a65dbec8bed166b9fd9629 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 25 Jun 2020 10:39:14 -0600 Subject: [PATCH 17/32] remove use of ifrac_nstod in fraction_mod make changes in fldsExchange for fraction_mod changes; fix DataInitialize --- mediator/esmFldsExchange_nems_mod.F90 | 3 +- mediator/med.F90 | 3 +- mediator/med_fraction_mod.F90 | 96 ++++++++++----------------- mediator/med_phases_prep_atm_mod.F90 | 56 ++++++++-------- 4 files changed, 65 insertions(+), 93 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 9c862a84e..28734c8ba 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -119,8 +119,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to atm: fractions (computed in med_phases_prep_atm) call addfld(fldListFr(compice)%flds, 'Si_ifrac') call addfld(fldListTo(compatm)%flds, 'Si_ifrac') - call addmap(fldListFr(compice)%flds, 'Si_ifrac', compatm, maptype, 'none', 'unset') - call addmrg(fldListTo(compatm)%flds, 'Si_ifrac', mrg_from1=compice, mrg_fld1='Si_ifrac', mrg_type1='copy') + call addfld(fldListTo(compatm)%flds, 'So_ofrac') ! to atm: unmerged from ice ! - zonal surface stress, meridional surface stress diff --git a/mediator/med.F90 b/mediator/med.F90 index f78e501d9..acf1e509b 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1823,7 +1823,6 @@ subroutine DataInitialize(gcomp, rc) call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - return endif ! end first_call if-block @@ -1861,7 +1860,7 @@ subroutine DataInitialize(gcomp, rc) ! 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 (ChkErr(rc,__LINE__,u_FILE_u)) return - atmdone = .false. + allDone = .false. exit ! break out of the loop when first not satisfied found endif enddo diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 54f9102b8..6c45051ae 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -174,9 +174,10 @@ subroutine med_fraction_init(gcomp, rc) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_GridCompGet, ESMF_StateIsCreated use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleIsCreated, ESMF_FieldBundleDestroy + use esmFlds , only : coupling_mode use esmFlds , only : compatm, compocn, compice, complnd use esmFlds , only : comprof, compglc, compwav, compname - use esmFlds , only : mapconsf, mapfcopy + use esmFlds , only : mapconsf, mapfcopy, mapnstod_consf use med_map_mod , only : med_map_Fractions_init, med_map_RH_is_created use med_internalstate_mod , only : InternalState use perf_mod , only : t_startf, t_stopf @@ -273,13 +274,13 @@ subroutine med_fraction_init(gcomp, rc) maptype = mapfcopy else maptype = mapconsf - if (.not. med_map_RH_is_created(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 (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + end if + if (.not. med_map_RH_is_created(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 (ChkErr(rc,__LINE__,u_FILE_u)) return end if call FB_FieldRegrid(& is_local%wrap%FBfrac(compatm), 'afrac', & @@ -359,7 +360,7 @@ subroutine med_fraction_init(gcomp, rc) end if !--------------------------------------- - ! Set 'ifrac' in FBFrac(compice) and BFrac(compatm) + ! Set 'ifrac' in FBFrac(compice) and FBrac(compatm) !--------------------------------------- if (is_local%wrap%comp_present(compice)) then @@ -425,7 +426,6 @@ subroutine med_fraction_init(gcomp, rc) end if end if - !--------------------------------------- ! Set 'lfrac' in FBFrac(compatm) and correct 'ofrac' in FBFrac(compatm) ! --------------------------------------- @@ -627,7 +627,7 @@ subroutine med_fraction_set(gcomp, rc) 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 : mapconsf, mapnstod, mapfcopy, mapnstod_consf use esmFlds , only : coupling_mode use med_internalstate_mod , only : InternalState use med_map_mod , only : med_map_Fractions_init, med_map_RH_is_created @@ -641,7 +641,6 @@ subroutine med_fraction_set(gcomp, rc) type(InternalState) :: is_local real(r8), pointer :: lfrac(:) real(r8), pointer :: ifrac(:) - real(r8), pointer :: ifrac_nstod(:) real(r8), pointer :: ofrac(:) real(r8), pointer :: Si_ifrac(:) real(r8), pointer :: Si_imask(:) @@ -718,9 +717,9 @@ subroutine med_fraction_set(gcomp, rc) ! set ifrac = Si_ifrac * Si_imask ifrac(:) = Si_ifrac(:) * Si_imask(:) - !ifrac(:) = Si_ifrac(:) - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then + !if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then + if (trim(coupling_mode) == 'nems_orig' ) then ofrac(:) = 1._r8 - ifrac(:) else ! set ofrac = Si_imask - ifrac @@ -754,53 +753,28 @@ subroutine med_fraction_set(gcomp, rc) ! ------------------------------------------- if (is_local%wrap%comp_present(compatm)) then - if (trim(coupling_mode) == 'nems_orig') then - - ! Map 'ifrac' from FBfrac(compice) to FBfrac(compatm) - call FB_FieldRegrid(& - is_local%wrap%FBfrac(compice), 'ifrac', & - is_local%wrap%FBfrac(compatm), 'ifrac', & - is_local%wrap%RH(compice,compatm,:),mapnstod, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ifrac', ifrac_nstod, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call FB_FieldRegrid(& - is_local%wrap%FBfrac(compice), 'ifrac', & - is_local%wrap%FBfrac(compatm), 'ifrac', & - is_local%wrap%RH(compice,compatm,:),mapconsf, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Determine ifrac on atm grid - call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ifrac', ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - where (ifrac .eq. 0.0_R8 .and. abs(ifrac_nstod) .gt. 0.0_R8) - ifrac = ifrac_nstod - endwhere - - ! Determine ofrac and lfrac on atm grid - set ofrac=1-ifrac and lfrac=0 - call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ofrac(:) = 1.0_R8 - ifrac(:) - lfrac(:) = 0.0_R8 - - else if (trim(coupling_mode) == 'nems_frac') then - - call FB_FieldRegrid(& - is_local%wrap%FBfrac(compice), 'ifrac', & - is_local%wrap%FBfrac(compatm), 'ifrac', & - is_local%wrap%RH(compice,compatm,:),mapconsf, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Determine ofrac and lfrac on atm grid - set ofrac=1-ifrac and lfrac=0 - call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ofrac(:) = 1.0_R8 - ifrac(:) - lfrac(:) = 0.0_R8 + if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac' ) then + + ! Set maptype according to coupling_mode + if (trim(coupling_mode) == 'nems_orig' ) then + maptype = mapnstod_consf + else + maptype = mapconsf + end if + + call FB_FieldRegrid(& + is_local%wrap%FBfrac(compice), 'ifrac', & + is_local%wrap%FBfrac(compatm), 'ifrac', & + is_local%wrap%RH(compice,compatm,:),maptype, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine ofrac and lfrac on atm grid - set ofrac=1-ifrac and lfrac=0 + call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ofrac(:) = 1.0_R8 - ifrac(:) + lfrac(:) = 0.0_R8 else diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index f479c3780..dc5ebf4bd 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -178,34 +178,34 @@ subroutine med_phases_prep_atm(gcomp, rc) !--- custom calculations !--------------------------------------- - ! ! set fractions to send back to atm - ! if (FB_FldChk(is_local%wrap%FBExp(compatm), 'So_ofrac', rc=rc)) then - ! call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'So_ofrac', dataptr1, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call FB_GetFldPtr(is_local%wrap%FBFrac(compatm), 'ofrac', dataptr2, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! do n = 1,size(dataptr1) - ! dataptr1(n) = dataptr2(n) - ! end do - ! end if - ! if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Si_ifrac', rc=rc)) then - ! call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Si_ifrac', dataptr1, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call FB_GetFldPtr(is_local%wrap%FBFrac(compatm), 'ifrac', dataptr2, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! do n = 1,size(dataptr1) - ! dataptr1(n) = dataptr2(n) - ! end do - ! end if - ! if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Sl_lfrac', rc=rc)) then - ! call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Sl_lfrac', dataptr1, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call FB_GetFldPtr(is_local%wrap%FBFrac(compatm), 'lfrac', dataptr2, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! do n = 1,size(dataptr1) - ! dataptr1(n) = dataptr2(n) - ! end do - ! end if + ! set fractions to send back to atm + if (FB_FldChk(is_local%wrap%FBExp(compatm), 'So_ofrac', rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'So_ofrac', dataptr1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBFrac(compatm), 'ofrac', dataptr2, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(dataptr1) + dataptr1(n) = dataptr2(n) + end do + end if + if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Si_ifrac', rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Si_ifrac', dataptr1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBFrac(compatm), 'ifrac', dataptr2, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(dataptr1) + dataptr1(n) = dataptr2(n) + end do + end if + if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Sl_lfrac', rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Sl_lfrac', dataptr1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBFrac(compatm), 'lfrac', dataptr2, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(dataptr1) + dataptr1(n) = dataptr2(n) + end do + end if !--------------------------------------- !--- update local scalar data From f727af2db51bac0799ad17c6a83320ea03c352c9 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 25 Jun 2020 12:57:39 -0600 Subject: [PATCH 18/32] add prep_ocn with app specific custom merge routines --- mediator/esmFldsExchange_nems_mod.F90 | 2 +- mediator/med_fraction_mod.F90 | 2 +- mediator/med_phases_prep_ocn_mod.F90 | 1111 +++++++++++++------------ 3 files changed, 600 insertions(+), 515 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 28734c8ba..e44e45f08 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -120,7 +120,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) call addfld(fldListFr(compice)%flds, 'Si_ifrac') call addfld(fldListTo(compatm)%flds, 'Si_ifrac') call addfld(fldListTo(compatm)%flds, 'So_ofrac') - + ! to atm: unmerged from ice ! - zonal surface stress, meridional surface stress ! - surface latent heat flux, diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 6c45051ae..08a2d233a 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -360,7 +360,7 @@ subroutine med_fraction_init(gcomp, rc) end if !--------------------------------------- - ! Set 'ifrac' in FBFrac(compice) and FBrac(compatm) + ! Set 'ifrac' in FBFrac(compice) and FBFrac(compatm) !--------------------------------------- if (is_local%wrap%comp_present(compice)) then diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 5001f837b..15ef2efbd 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -33,6 +33,10 @@ module med_phases_prep_ocn_mod public :: med_phases_prep_ocn_accum_fast public :: med_phases_prep_ocn_accum_avg + private :: med_phases_prep_ocn_custom_cesm + private :: med_phases_prep_ocn_custom_nems + private :: med_phases_prep_ocn_custom_nemsdata + character(*), parameter :: u_FILE_u = & __FILE__ @@ -46,10 +50,8 @@ 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 ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS ! input/output variables type(ESMF_GridComp) :: gcomp @@ -58,37 +60,29 @@ subroutine med_phases_prep_ocn_map(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: n1, ncnt - integer :: dbrc character(len=*), parameter :: subname='(med_phases_prep_ocn_map)' !------------------------------------------------------------------------------- + rc = ESMF_SUCCESS + call t_startf('MED:'//subname) if (dbug_flag > 20) then - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) end if - rc = ESMF_SUCCESS call memcheck(subname, 5, mastertask) - !--------------------------------------- - ! --- Get the internal state - !--------------------------------------- - + ! 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 - !--------------------------------------- + ! Count the number of fields outside of scalar data, if zero, then return call FB_getNumFlds(is_local%wrap%FBExp(compocn), trim(subname)//"FBexp(compocn)", ncnt, rc) if (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 - !--------------------------------------- - + ! 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( & @@ -107,17 +101,15 @@ subroutine med_phases_prep_ocn_map(gcomp, rc) call t_stopf('MED:'//subname) if (dbug_flag > 20) then - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) 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_GridComp, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR ! input/output variables @@ -127,78 +119,34 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: n, ncnt - real(R8) :: c1,c2,c3,c4 - real(R8), pointer :: dataptr(:) - real(R8), pointer :: dataptr_o(:) - 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_afracr(:) - 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) :: 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 - logical :: export_swnet_by_bands - logical :: import_swpen_by_bands - logical :: export_swnet_afracr - logical :: first_precip_fact_call = .true. - real(R8) :: precip_fact - integer :: lsize - integer :: dbrc - character(CS) :: cvalue - real(R8), pointer :: ocnwgt1(:) ! NEMS_orig_data - real(R8), pointer :: icewgt1(:) ! NEMS_orig_data - real(R8), pointer :: wgtp01(:) ! NEMS_orig_data - real(R8), pointer :: wgtm01(:) ! NEMS_orig_data - real(R8), pointer :: customwgt(:) ! NEMS_orig_data - 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)' - logical :: compare_to_mct = .false. ! Set the following to true if want to compare directly to MCT !--------------------------------------- call t_startf('MED:'//subname) if (dbug_flag > 20) then - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) end if rc = ESMF_SUCCESS call memcheck(subname, 5, mastertask) - !--------------------------------------- - ! --- Get the internal state - !--------------------------------------- - + ! 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 - !--------------------------------------- - + ! Count the number of fields outside of scalar data, if zero, then return call FB_getNumFlds(is_local%wrap%FBExp(compocn), trim(subname)//"FBexp(compocn)", ncnt, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ncnt > 0) then !--------------------------------------- - !--- auto merges to ocn + ! merges to ocean !--------------------------------------- + ! auto merges to ocn if (trim(coupling_mode) == 'cesm' .or. & - trim(coupling_mode) == 'nems_orig_data' .or. & + trim(coupling_mode) == 'nems_orig_data' .or. & trim(coupling_mode) == 'hafs') then call med_merge_auto(trim(compname(compocn)), & is_local%wrap%FBExp(compocn), is_local%wrap%FBFrac(compocn), & @@ -212,415 +160,40 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - !--------------------------------------- - !--- custom calculations - !--------------------------------------- - + ! custom merges to ocean if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'hafs') then - - !------------- - ! 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 (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swndr', Faxa_swndr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swvdf', Faxa_swvdf, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swndf', Faxa_swndf, rc=rc) - if (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 (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac' , ofrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Input from mediator, ocean albedos - call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_avsdr' , avsdr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_anidr' , anidr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_avsdf' , avsdf, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_anidf' , anidf, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrad' , ifracr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrad' , ofracr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! 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 (ChkErr(rc,__LINE__,u_FILE_u)) return - if (FB_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 (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 (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 (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 (ChkErr(rc,__LINE__,u_FILE_u)) return - else - import_swpen_by_bands = .false. - end if - end if - - ! Output to ocean swnet - if (FB_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 (ChkErr(rc,__LINE__,u_FILE_u)) return - else - lsize = size(Faxa_swvdr) - allocate(Foxx_swnet(lsize)) - end if - - ! Output to ocean swnet by radiation bands - if (FB_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 (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', Foxx_swnet_vdf, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', Foxx_swnet_idr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', Foxx_swnet_idf, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - export_swnet_by_bands = .false. - end if - - ! Swnet without swpen from sea-ice - if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr',rc=rc)) then - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr', Foxx_swnet_afracr, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - export_swnet_afracr = .true. - else - export_swnet_afracr = .false. - end if - - do n = 1,lsize - - ! Determine ocean albedos - albvis_dir = avsdr(n) - albvis_dif = avsdf(n) - albnir_dir = anidr(n) - albnir_dif = anidf(n) - - ! 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 - - 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 - - Foxx_swnet(n) = ofracr_scaled*(fswabsv + fswabsi) + ifrac_scaled*Fioi_swpen(n) - - if (export_swnet_afracr) then - Foxx_swnet_afracr(n) = ofracr_scaled*(fswabsv + fswabsi) - end if - - ! To compare to mct - if (compare_to_mct) then - 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) - else - 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 - end if - - end if ! if sea-ice is present - end do - - ! Deallocate Foxx_swnet if it was allocated in this subroutine - if (.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then - deallocate(Foxx_swnet) - end if - - ! Output to ocean per ice thickness fraction and sw penetrating into ocean - if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Sf_afrac', rc=rc)) then - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afrac', fldptr1=dataptr_o, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - dataptr_o(:) = ofrac(:) - end if - if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Sf_afracr', rc=rc)) then - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afracr', fldptr1=dataptr_o, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - dataptr_o(:) = ofracr(:) - end if - - !------------- - ! application of precipitation factor from ocean - !------------- - precip_fact = 1.0_R8 - if (precip_fact /= 1.0_R8) then - if (first_precip_fact_call .and. mastertask) then - write(logunit,'(a)')'(merge_to_ocn): Scaling rain, snow, liquid and ice runoff by precip_fact ' - first_precip_fact_call = .false. - end if - write(cvalue,*) precip_fact - call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) - - allocate(fldnames(4)) - fldnames = (/'Faxa_rain','Faxa_snow', 'Foxx_rofl', 'Foxx_rofi'/) - do n = 1,size(fldnames) - if (FB_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 (ChkErr(rc,__LINE__,u_FILE_u)) return - dataptr(:) = dataptr(:) * precip_fact - end if - end do - deallocate(fldnames) - end if - end if - - !------------- - ! Custom calculation for nems_orig or nems_frac - !------------- - - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then - - ! get ice and open ocean fractions on the ocn mesh - call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrac' , ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac' , ofrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - lsize = size(ofrac) - allocate(customwgt(lsize)) - - call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_rain', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_rain' , wgtA=ofrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_snow', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_snow' , wgtA=ofrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_lwnet', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_lwnet', wgtA=ofrac, rc=rc) + call med_phases_prep_ocn_custom_cesm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - customwgt(:) = -ofrac(:) / const_lhvap - call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_evap', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_lat' , wgtA=customwgt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - customwgt(:) = -ofrac(:) - call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_sen', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_sen', wgtA=customwgt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_taux', & - FBinA=is_local%wrap%FBImp(compice,compocn), fnameA='Fioi_taux' , wgtA=ifrac, & - FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_taux' , wgtB=customwgt, rc=rc) + else if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then + call med_phases_prep_ocn_custom_nems(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_tauy', & - FBinA=is_local%wrap%FBImp(compice,compocn), fnameA='Fioi_tauy' , wgtA=ifrac, & - FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_tauy' , wgtB=customwgt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - - ! netsw_for_ocn = [downsw_from_atm*(1-ice_fraction)*(1-ocn_albedo)] + [pensw_from_ice*(ice_fraction)] - customwgt(:) = ofrac(:) * (1.0 - 0.06) - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdr' , wgtA=customwgt, & - FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdr', wgtB=ifrac, rc=rc) + else if (trim(coupling_mode) == 'nems_orig_data') then + call med_phases_prep_ocn_custom_nemsdata(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdf' , wgtA=customwgt, & - FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdf', wgtB=ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndr' , wgtA=customwgt, & - FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idr', wgtB=ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndf' , wgtA=customwgt, & - FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idf', wgtB=ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - deallocate(customwgt) - - end if ! end of nems_orig or nems_frac - - !------------- - ! Custom calculation for nems_orig_data - !------------- - - if (trim(coupling_mode) == 'nems_orig_data') 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 - ! ocnwgt1+icewgt1+wgtp01 = 1.0 always - ! wgtp01 and wgtm01 are the same just one is +1 and the other is -1 to change sign depending on the ice fraction. - ! 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 - call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_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 (ChkErr(rc,__LINE__,u_FILE_u)) return - - call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_sen', & - FBinA=is_local%wrap%FBMed_aoflux_o , fnameA='Faox_sen ', wgtA=ocnwgt1, & - FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_sen' , wgtB=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) - - call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_rain' , & - FBInA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_rain' , wgtA=ofrac, rc=rc) - - call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_snow' , & - FBInA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_snow' , wgtA=ofrac, rc=rc) - - deallocate(ocnwgt1) - deallocate(icewgt1) - deallocate(wgtp01) - deallocate(wgtm01) - deallocate(customwgt) - end if ! end of nems_orig_data custom - !--------------------------------------- - !--- diagnose output - !--------------------------------------- - + ! diagnose output if (dbug_flag > 1) then - call FB_diagnose(is_local%wrap%FBExp(compocn), & - string=trim(subname)//' FBexp(compocn) ', rc=rc) + call FB_diagnose(is_local%wrap%FBExp(compocn), string=trim(subname)//' FBexp(compocn) ', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! TODO (mvertens, 2018-12-16): document above custom calculation - - !--------------------------------------- - !--- clean up - !--------------------------------------- - endif if (dbug_flag > 20) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) 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_GridComp, ESMF_GridCompGet, 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 ! input/output variables type(ESMF_GridComp) :: gcomp @@ -629,39 +202,29 @@ subroutine med_phases_prep_ocn_accum_fast(gcomp, 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 - !--------------------------------------- + call t_startf('MED:'//subname) + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + ! 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 - !--------------------------------------- + ! Count the number of fields outside of scalar data, if zero, then return call FB_getNumFlds(is_local%wrap%FBExp(compocn), trim(subname)//"FBexp(compocn)", ncnt, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ncnt > 0) then - - !--------------------------------------- - !--- ocean accumulator - !--------------------------------------- - + ! ocean accumulator call FB_accum(is_local%wrap%FBExpAccum(compocn), is_local%wrap%FBExp(compocn), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -672,96 +235,70 @@ subroutine med_phases_prep_ocn_accum_fast(gcomp, rc) string=trim(subname)//' FBExpAccum accumulation ', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - - !--------------------------------------- - !--- clean up - !--------------------------------------- endif if (dbug_flag > 20) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) 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 ESMF , only : ESMF_GridComp, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS ! 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 + integer :: ncnt 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 - !--------------------------------------- + call t_startf('MED:'//subname) + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + ! 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 - !--------------------------------------- + ! Count the number of fields outside of scalar data, if zero, then return call FB_getNumFlds(is_local%wrap%FBExpAccum(compocn), trim(subname)//"FBExpAccum(compocn)", ncnt, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ncnt > 0) then - !--------------------------------------- - !--- average ocn accumulator - !--------------------------------------- - + ! average ocn accumulator if (dbug_flag > 1) then call FB_diagnose(is_local%wrap%FBExpAccum(compocn), & string=trim(subname)//' FBExpAccum(compocn) before avg ', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call FB_average(is_local%wrap%FBExpAccum(compocn), & is_local%wrap%FBExpAccumCnt(compocn), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 1) then call FB_diagnose(is_local%wrap%FBExp(compocn), & string=trim(subname)//' FBExpAccum(compocn) after avg ', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - !--------------------------------------- - !--- copy to FBExp(compocn) - !--------------------------------------- - + ! copy to FBExp(compocn) call FB_copy(is_local%wrap%FBExp(compocn), is_local%wrap%FBExpAccum(compocn), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !--------------------------------------- - !--- zero accumulator - !--------------------------------------- - + ! zero accumulator is_local%wrap%FBExpAccumFlag(compocn) = .true. is_local%wrap%FBExpAccumCnt(compocn) = 0 call FB_reset(is_local%wrap%FBExpAccum(compocn), value=czero, rc=rc) @@ -770,10 +307,558 @@ subroutine med_phases_prep_ocn_accum_avg(gcomp, rc) end if if (dbug_flag > 20) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if call t_stopf('MED:'//subname) end subroutine med_phases_prep_ocn_accum_avg + !----------------------------------------------------------------------------- + subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) + + !--------------------------------------- + ! custom calculations for cesm + !--------------------------------------- + + use ESMF , only : ESMF_GridComp + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + 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_afracr(:) + 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 :: dataptr(:) + real(R8), pointer :: dataptr_o(:) + real(R8) :: frac_sum + real(R8) :: ifrac_scaled, ofrac_scaled + real(R8) :: ifracr_scaled, ofracr_scaled + logical :: export_swnet_by_bands + logical :: import_swpen_by_bands + logical :: export_swnet_afracr + logical :: first_precip_fact_call = .true. + real(R8) :: precip_fact + character(CS) :: cvalue + real(R8) :: fswabsv, fswabsi + integer :: n + integer :: lsize + real(R8) :: c1,c2,c3,c4 + character(len=64), allocatable :: fldnames(:) + character(len=*), parameter :: subname='(med_phases_prep_ocn_custom_cesm)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + if (dbug_flag > 20) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + end if + call memcheck(subname, 5, mastertask) + + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + ! 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 (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swndr', Faxa_swndr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swvdf', Faxa_swvdf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swndf', Faxa_swndf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + lsize = size(Faxa_swvdr) + + ! Input from mediator, ocean albedos + call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_avsdr' , avsdr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_anidr' , anidr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_avsdf' , avsdf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_anidf' , anidf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Output to ocean swnet total + if (FB_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 (ChkErr(rc,__LINE__,u_FILE_u)) return + else + lsize = size(Faxa_swvdr) + allocate(Foxx_swnet(lsize)) + end if + + ! Output to ocean swnet by radiation bands + if (FB_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 (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', Foxx_swnet_vdf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', Foxx_swnet_idr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', Foxx_swnet_idf, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + export_swnet_by_bands = .false. + end if + + ! ----------------------- + ! If cice IS NOT PRESENT + ! ----------------------- + if (.not. is_local%wrap%comp_present(compice)) then + ! Compute total swnet to ocean independent of swpen from sea-ice + do n = 1,lsize + fswabsv = Faxa_swvdr(n) * (1.0_R8 - avsdr(n)) + Faxa_swvdf(n) * (1.0_R8 - avsdf(n)) + fswabsi = Faxa_swndr(n) * (1.0_R8 - anidr(n)) + Faxa_swndf(n) * (1.0_R8 - anidf(n)) + Foxx_swnet(n) = fswabsv + fswabsi + end do + ! Compute sw export to ocean bands if required + if (export_swnet_by_bands) then + c1 = 0.285; c2 = 0.285; c3 = 0.215; c4 = 0.215 + Foxx_swnet_vdr(:) = c1 * Foxx_swnet(:) + Foxx_swnet_vdf(:) = c2 * Foxx_swnet(:) + Foxx_swnet_idr(:) = c3 * Foxx_swnet(:) + Foxx_swnet_idf(:) = c4 * Foxx_swnet(:) + end if + end if + + ! ----------------------- + ! If cice IS PRESENT + ! ----------------------- + if (is_local%wrap%comp_present(compice)) then + + ! Input from mediator, ice-covered ocean and open ocean fractions + call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrac' , ifrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac' , ofrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrad' , ifracr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrad' , ofracr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen', Fioi_swpen, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (FB_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 (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 (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 (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 (ChkErr(rc,__LINE__,u_FILE_u)) return + else + import_swpen_by_bands = .false. + end if + + ! Swnet without swpen from sea-ice + if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr',rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr', Foxx_swnet_afracr, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + export_swnet_afracr = .true. + else + export_swnet_afracr = .false. + end if + + do n = 1,lsize + ! Compute total swnet to ocean independent of swpen from sea-ice + fswabsv = Faxa_swvdr(n) * (1.0_R8 - avsdr(n)) + Faxa_swvdf(n) * (1.0_R8 - avsdf(n)) + fswabsi = Faxa_swndr(n) * (1.0_R8 - anidr(n)) + Faxa_swndf(n) * (1.0_R8 - anidf(n)) + Foxx_swnet(n) = fswabsv + fswabsi + + ! Add swpen from sea ice + 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 + Foxx_swnet(n) = ofracr_scaled*(fswabsv + fswabsi) + ifrac_scaled*Fioi_swpen(n) + + if (export_swnet_afracr) then + Foxx_swnet_afracr(n) = ofracr_scaled*(fswabsv + fswabsi) + end if + + ! Compute sw export to ocean bands if required + 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-avsdr(n))*ofracr_scaled + Fioi_swpen_vdr(n)*ifrac_scaled + Foxx_swnet_vdf(n) = Faxa_swvdf(n)*(1.0_R8-avsdf(n))*ofracr_scaled + Fioi_swpen_vdf(n)*ifrac_scaled + Foxx_swnet_idr(n) = Faxa_swndr(n)*(1.0_R8-anidr(n))*ofracr_scaled + Fioi_swpen_idr(n)*ifrac_scaled + Foxx_swnet_idf(n) = Faxa_swndf(n)*(1.0_R8-anidf(n))*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 + end do + + ! Output to ocean per ice thickness fraction and sw penetrating into ocean + if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Sf_afrac', rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afrac', fldptr1=dataptr_o, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + dataptr_o(:) = ofrac(:) + end if + if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Sf_afracr', rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afracr', fldptr1=dataptr_o, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + dataptr_o(:) = ofracr(:) + end if + + end if ! if sea-ice is present + + ! Deallocate Foxx_swnet if it was allocated in this subroutine + if (.not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then + deallocate(Foxx_swnet) + end if + + !--------------------------------------- + ! application of precipitation factor from ocean + !--------------------------------------- + precip_fact = 1.0_R8 + if (precip_fact /= 1.0_R8) then + if (first_precip_fact_call .and. mastertask) then + write(logunit,'(a)')'(merge_to_ocn): Scaling rain, snow, liquid and ice runoff by precip_fact ' + first_precip_fact_call = .false. + end if + write(cvalue,*) precip_fact + call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO) + + allocate(fldnames(4)) + fldnames = (/'Faxa_rain','Faxa_snow', 'Foxx_rofl', 'Foxx_rofi'/) + do n = 1,size(fldnames) + if (FB_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 (ChkErr(rc,__LINE__,u_FILE_u)) return + dataptr(:) = dataptr(:) * precip_fact + end if + end do + deallocate(fldnames) + end if + + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + end if + call t_stopf('MED:'//subname) + + end subroutine med_phases_prep_ocn_custom_cesm + + !----------------------------------------------------------------------------- + subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) + + ! ---------------------------------------------- + ! Custom calculation for nems_orig or nems_frac + ! ---------------------------------------------- + + use ESMF , only : ESMF_GridComp + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + real(R8), pointer :: ocnwgt1(:) + real(R8), pointer :: icewgt1(:) + real(R8), pointer :: wgtp01(:) + real(R8), pointer :: wgtm01(:) + real(R8), pointer :: customwgt(:) + real(R8), pointer :: ifrac(:) + real(R8), pointer :: ofrac(:) + integer :: lsize + real(R8) , parameter :: const_lhvap = 2.501e6_R8 ! latent heat of evaporation ~ J/kg + character(len=*), parameter :: subname='(med_phases_prep_ocn_custom_nems)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + if (dbug_flag > 20) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + end if + call memcheck(subname, 5, mastertask) + + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! get ice and open ocean fractions on the ocn mesh + call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrac' , ifrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac' , ofrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + lsize = size(ofrac) + allocate(customwgt(lsize)) + + call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_rain', & + FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_rain' , wgtA=ofrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_snow', & + FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_snow' , wgtA=ofrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_lwnet', & + FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_lwnet', wgtA=ofrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + customwgt(:) = -ofrac(:) / const_lhvap + call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_evap', & + FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_lat' , wgtA=customwgt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + customwgt(:) = -ofrac(:) + call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_sen', & + FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_sen', wgtA=customwgt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_taux', & + FBinA=is_local%wrap%FBImp(compice,compocn), fnameA='Fioi_taux' , wgtA=ifrac, & + FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_taux' , wgtB=customwgt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_tauy', & + FBinA=is_local%wrap%FBImp(compice,compocn), fnameA='Fioi_tauy' , wgtA=ifrac, & + FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_tauy' , wgtB=customwgt, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! netsw_for_ocn = [downsw_from_atm*(1-ice_fraction)*(1-ocn_albedo)] + [pensw_from_ice*(ice_fraction)] + customwgt(:) = ofrac(:) * (1.0 - 0.06) + call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', & + FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdr' , wgtA=customwgt, & + FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdr', wgtB=ifrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', & + FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdf' , wgtA=customwgt, & + FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdf', wgtB=ifrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', & + FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndr' , wgtA=customwgt, & + FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idr', wgtB=ifrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', & + FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndf' , wgtA=customwgt, & + FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idf', wgtB=ifrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + deallocate(customwgt) + + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + end if + call t_stopf('MED:'//subname) + + end subroutine med_phases_prep_ocn_custom_nems + + !----------------------------------------------------------------------------- + subroutine med_phases_prep_ocn_custom_nemsdata(gcomp, rc) + + ! ---------------------------------------------- + ! Custom calculation for nems_orig_data + ! ---------------------------------------------- + + use ESMF , only : ESMF_GridComp + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + real(R8), pointer :: ocnwgt1(:) ! NEMS_orig_data + real(R8), pointer :: icewgt1(:) ! NEMS_orig_data + real(R8), pointer :: wgtp01(:) ! NEMS_orig_data + real(R8), pointer :: wgtm01(:) ! NEMS_orig_data + real(R8), pointer :: customwgt(:) ! NEMS_orig_data + real(R8), pointer :: ifrac(:) + real(R8), pointer :: ofrac(:) + integer :: lsize + integer :: n + real(R8) , parameter :: const_lhvap = 2.501e6_R8 ! latent heat of evaporation ~ J/kg + character(len=*), parameter :: subname='(med_phases_prep_ocn_custom_nemsdata)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + if (dbug_flag > 20) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + end if + call memcheck(subname, 5, mastertask) + + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! get ice and open ocean fractions on the ocn mesh + call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrac' , ifrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac' , ofrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + lsize = size(ofrac) + allocate(customwgt(lsize)) + + ! 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 + ! ocnwgt1+icewgt1+wgtp01 = 1.0 always + ! wgtp01 and wgtm01 are the same just one is +1 and the other is -1 to change sign depending on the ice fraction. + ! 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 + ! TODO: check if this condition is still required + if(ofrac(n)+ifrac(n) /= 0._R8)then + 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 = ESMF_FAILURE + return + endif + endif + end do + + customwgt(:) = wgtm01(:) / const_lhvap + call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_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 (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_sen', & + FBinA=is_local%wrap%FBMed_aoflux_o , fnameA='Faox_sen ', wgtA=ocnwgt1, & + FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_sen' , wgtB=wgtm01, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + 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) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + 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 (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! 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) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_rain' , & + FBInA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_rain' , wgtA=ofrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_snow' , & + FBInA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_snow' , wgtA=ofrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! netsw_for_ocn = [downsw_from_atm*(1-ice_fraction)*(1-ocn_albedo)] + [pensw_from_ice*(ice_fraction)] + customwgt(:) = ofrac(:) * (1.0 - 0.06) + call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', & + FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdr' , wgtA=customwgt, & + FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdr', wgtB=ifrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', & + FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdf' , wgtA=customwgt, & + FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdf', wgtB=ifrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', & + FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndr' , wgtA=customwgt, & + FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idr', wgtB=ifrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', & + FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndf' , wgtA=customwgt, & + FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idf', wgtB=ifrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + deallocate(ocnwgt1) + deallocate(icewgt1) + deallocate(wgtp01) + deallocate(wgtm01) + deallocate(customwgt) + + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + end if + call t_stopf('MED:'//subname) + + end subroutine med_phases_prep_ocn_custom_nemsdata + end module med_phases_prep_ocn_mod From 94b7b261b0cb37ce713d5a3264da38e5ed7540c3 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 26 Jun 2020 11:34:11 -0600 Subject: [PATCH 19/32] update default value of PIO_REARR_COMM_MAX_PEND_REQ_COMP2IO --- cime_config/config_component.xml | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 1ab4683ca..ecde8a538 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -1985,10 +1985,14 @@ integer - 0 + -2 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 + pio rearranger communication max pending requests (io2comp) : + -2 implies that CIME internally calculates the value ( = 64), + -1 implies no bound on max pending requests + 0 implies that MPI_ALLTOALL will be used + From e0b838ac3a1d5d676173c35608a9432852a08a8d Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Fri, 26 Jun 2020 11:35:38 -0600 Subject: [PATCH 20/32] add fix from datm for nextsw_cday not being present --- mediator/med_methods_mod.F90 | 2 +- mediator/med_phases_prep_ice_mod.F90 | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 8061a1752..649f8eb3c 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -163,7 +163,7 @@ subroutine med_methods_FB_RWFields(mode,fname,FB,flag,rc) enddo call med_methods_FB_diagnose(FB, 'read '//trim(fname), rc) - if (present(flag)) flag = .true. + if (present(flag)) flag = .true. endif else diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index e6a5e95f7..f4045f507 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -169,6 +169,7 @@ subroutine med_phases_prep_ice(gcomp, rc) call ESMF_StateGet(is_local%wrap%NStateImp(compatm), trim(is_local%wrap%flds_scalar_name), itemType, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (itemType /= ESMF_STATEITEM_NOTFOUND) then + if (is_local%wrap%flds_scalar_index_nextsw_cday .ne. 0) then ! send nextsw_cday to ice - first obtain it from atm import call State_GetScalar(& scalar_value=nextsw_cday, & @@ -184,6 +185,7 @@ subroutine med_phases_prep_ice(gcomp, rc) flds_scalar_name=is_local%wrap%flds_scalar_name, & flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + end if end if !--------------------------------------- From cd203d206b0c613092f4990602709d131c44f81a Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sun, 28 Jun 2020 05:48:04 -0600 Subject: [PATCH 21/32] remove aoflux fields from exchange unless using nems_orig_data clean up med_fraction_mod --- mediator/esmFldsExchange_nems_mod.F90 | 43 +++++++++--------- mediator/med_fraction_mod.F90 | 64 +++------------------------ 2 files changed, 28 insertions(+), 79 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index e44e45f08..fdd898201 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -83,26 +83,28 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) call addfld(fldListFr(compocn)%flds, 'So_omask') call addmap(fldListFr(compocn)%flds, 'So_omask', compice, mapfcopy, 'unset', 'unset') - ! atm and ocn fields required for atm/ocn flux calculation' - allocate(flds(6)) - flds = (/'Sa_u ','Sa_v ', 'Sa_z ', 'Sa_tbot', 'Sa_pbot', 'Sa_shum'/) - do n = 1,size(flds) - fldname = trim(flds(n)) - call addfld(fldListFr(compatm)%flds, trim(fldname)) - call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, maptype, 'none', 'unset') - end do - deallocate(flds) - - ! unused fields needed by the atm/ocn flux computation - allocate(flds(13)) - flds = (/'So_tref ', 'So_qref ','So_u10 ', 'So_ustar ','So_ssq ', & - 'So_re ', 'So_duu10n','Faox_lwup', 'Faox_sen ','Faox_lat ', & - 'Faox_evap', 'Faox_taux','Faox_tauy'/) - do n = 1,size(flds) - fldname = trim(flds(n)) - call addfld(fldListMed_aoflux%flds, trim(fldname)) - end do - deallocate(flds) + if ( trim(coupling_mode) == 'nems_orig_data') then + ! atm and ocn fields required for atm/ocn flux calculation' + allocate(flds(6)) + flds = (/'Sa_u ','Sa_v ', 'Sa_z ', 'Sa_tbot', 'Sa_pbot', 'Sa_shum'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, maptype, 'none', 'unset') + end do + deallocate(flds) + + ! unused fields needed by the atm/ocn flux computation + allocate(flds(13)) + flds = (/'So_tref ', 'So_qref ','So_u10 ', 'So_ustar ','So_ssq ', & + 'So_re ', 'So_duu10n','Faox_lwup', 'Faox_sen ','Faox_lat ', & + 'Faox_evap', 'Faox_taux','Faox_tauy'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + call addfld(fldListMed_aoflux%flds, trim(fldname)) + end do + deallocate(flds) + end if ! unused fields from ice - but that are needed to be realized by the cice cap call addfld(fldListFr(compice)%flds, 'Si_avsdf') @@ -119,7 +121,6 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to atm: fractions (computed in med_phases_prep_atm) call addfld(fldListFr(compice)%flds, 'Si_ifrac') call addfld(fldListTo(compatm)%flds, 'Si_ifrac') - call addfld(fldListTo(compatm)%flds, 'So_ofrac') ! to atm: unmerged from ice ! - zonal surface stress, meridional surface stress diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 08a2d233a..36bf60fbf 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -141,24 +141,7 @@ module med_fraction_mod 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 - + real(R8) , parameter :: eps_fraclim = 1.0e-03 ! truncation limit in fractions_a(lfrac) character(*), parameter :: u_FILE_u = & __FILE__ @@ -443,17 +426,11 @@ subroutine med_fraction_init(gcomp, 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 @@ -469,9 +446,6 @@ subroutine med_fraction_init(gcomp, rc) 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 @@ -718,8 +692,7 @@ subroutine med_fraction_set(gcomp, rc) ! set ifrac = Si_ifrac * Si_imask ifrac(:) = Si_ifrac(:) * Si_imask(:) - !if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then - if (trim(coupling_mode) == 'nems_orig' ) then + if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data' ) then ofrac(:) = 1._r8 - ifrac(:) else ! set ofrac = Si_imask - ifrac @@ -768,13 +741,11 @@ subroutine med_fraction_set(gcomp, rc) is_local%wrap%RH(compice,compatm,:),maptype, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine ofrac and lfrac on atm grid - set ofrac=1-ifrac and lfrac=0 - call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc) + call FB_FieldRegrid(& + is_local%wrap%FBfrac(compice), 'ofrac', & + is_local%wrap%FBfrac(compatm), 'ofrac', & + is_local%wrap%RH(compice,compatm,:),maptype, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ofrac(:) = 1.0_R8 - ifrac(:) - lfrac(:) = 0.0_R8 else @@ -804,29 +775,6 @@ subroutine med_fraction_set(gcomp, rc) if (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 FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ifrac', ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc) - if (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 From 554964a4119f6c1d8749249f46f040b8486efeb8 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sun, 28 Jun 2020 09:07:11 -0600 Subject: [PATCH 22/32] move med_fraction_init and set into first_call for DataInitialize --- mediator/med.F90 | 24 ++++++++++++------------ mediator/med_fraction_mod.F90 | 2 +- mediator/med_map_mod.F90 | 2 +- 3 files changed, 14 insertions(+), 14 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index acf1e509b..b924630a6 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1819,6 +1819,18 @@ subroutine DataInitialize(gcomp, rc) call med_map_MapNorm_init(gcomp, logunit, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + !---------------------------------------------------------- + ! 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 (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_fraction_set(gcomp,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + first_call = .false. call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) @@ -1826,18 +1838,6 @@ subroutine DataInitialize(gcomp, rc) endif ! end first_call if-block - !---------------------------------------------------------- - ! 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 (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_fraction_set(gcomp,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - !--------------------------------------- ! Carry out data dependency for initialization for NEMS !--------------------------------------- diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 36bf60fbf..b45aac750 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -693,7 +693,7 @@ subroutine med_fraction_set(gcomp, rc) ifrac(:) = Si_ifrac(:) * Si_imask(:) if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data' ) then - ofrac(:) = 1._r8 - ifrac(:) + ofrac(:) = 1.0_R8 - ifrac(:) else ! set ofrac = Si_imask - ifrac ofrac(:) = Si_imask(:) - ifrac(:) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index ec60b5f3e..e0aafb600 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -225,7 +225,7 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) 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) + call ESMF_LogWrite(subname // trim(string) // ' RH redist ', ESMF_LOGMSG_INFO) call ESMF_FieldRedistStore(fldsrc, flddst, & routehandle=is_local%wrap%RH(n1,n2,mapindex), & ignoreUnmatchedIndices = .true., rc=rc) From 85438fab5a590aa0e7fb2d22bfd3fcad4a5f219c Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sun, 28 Jun 2020 11:47:13 -0600 Subject: [PATCH 23/32] revert change to med.F90 in DataInitialize remove coupling mode dependence for setting ofrac in med_fraction_mod --- mediator/med.F90 | 24 ++++++++++++------------ mediator/med_fraction_mod.F90 | 11 ++++------- 2 files changed, 16 insertions(+), 19 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index b924630a6..acf1e509b 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1819,18 +1819,6 @@ subroutine DataInitialize(gcomp, rc) call med_map_MapNorm_init(gcomp, logunit, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !---------------------------------------------------------- - ! 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 (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_fraction_set(gcomp,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - first_call = .false. call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) @@ -1838,6 +1826,18 @@ subroutine DataInitialize(gcomp, rc) endif ! end first_call if-block + !---------------------------------------------------------- + ! 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 (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_fraction_set(gcomp,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + !--------------------------------------- ! Carry out data dependency for initialization for NEMS !--------------------------------------- diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index b45aac750..f56551cd7 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -622,6 +622,7 @@ subroutine med_fraction_set(gcomp, rc) integer :: dbrc integer :: maptype character(len=*),parameter :: subname='(med_fraction_set)' + !--------------------------------------- call t_startf('MED:'//subname) @@ -681,7 +682,7 @@ subroutine med_fraction_set(gcomp, rc) call FB_getFldPtr(is_local%wrap%FBImp(compice,compice) , 'Si_ifrac', Si_ifrac, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_getFldPtr(is_local%wrap%FBImp(compice,compice) , 'Si_imask' , Si_imask, rc=rc) + call FB_getFldPtr(is_local%wrap%FBImp(compice,compice) , 'Si_imask', Si_imask, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_getFldPtr(is_local%wrap%FBfrac(compice), 'ifrac', ifrac, rc=rc) @@ -692,12 +693,8 @@ subroutine med_fraction_set(gcomp, rc) ! set ifrac = Si_ifrac * Si_imask ifrac(:) = Si_ifrac(:) * Si_imask(:) - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data' ) then - ofrac(:) = 1.0_R8 - ifrac(:) - else - ! set ofrac = Si_imask - ifrac - ofrac(:) = Si_imask(:) - ifrac(:) - end if + ! set ofrac = Si_imask - ifrac + ofrac(:) = Si_imask(:) - ifrac(:) ! ------------------------------------------- ! Set FBfrac(compocn) From 49572f0b98c6f7d01251d77a4112a36dc984d6b9 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 29 Jun 2020 10:28:33 -0600 Subject: [PATCH 24/32] remove TODO in history write --- mediator/med_phases_history_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index a2ffe9371..f4f60f09f 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -427,7 +427,6 @@ subroutine med_phases_history_write(gcomp, rc) call med_io_write(hist_file, iam, is_local%wrap%FBMed_ocnalb_o, & nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='Med_alb_ocn', rc=rc) end if - !TODO: don't write aoflux_(oa) when they're not being used if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o,rc=rc)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) From 62898dc1459ecedfaa4feaba14052e6c4ea075f9 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 30 Jun 2020 07:02:56 -0600 Subject: [PATCH 25/32] update prep_ocn for bulk fluxes in nems_data_orig --- mediator/med_phases_prep_ocn_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 15ef2efbd..d182fe998 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -757,10 +757,10 @@ subroutine med_phases_prep_ocn_custom_nemsdata(gcomp, rc) do n = 1,lsize if (ifrac(n) <= 0._R8) then ! ice fraction is 0 - ocnwgt1(n) = 0.0_R8 + ocnwgt1(n) = 1.0_R8 icewgt1(n) = 0.0_R8 - wgtp01(n) = 1.0_R8 - wgtm01(n) = -1.0_R8 + wgtp01(n) = 0.0_R8 + wgtm01(n) = 0.0_R8 else ! ice fraction is > 0 ocnwgt1(n) = ofrac(n) From 49c13b8510f262aec964e6183b8456166aba0f6e Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 1 Jul 2020 05:53:17 -0600 Subject: [PATCH 26/32] add variables for dictionary for cice6 --- mediator/fd_nems.yaml | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/mediator/fd_nems.yaml b/mediator/fd_nems.yaml index f0fcad822..a92d94632 100644 --- a/mediator/fd_nems.yaml +++ b/mediator/fd_nems.yaml @@ -105,7 +105,11 @@ - standard_name: Sa_pslv alias: inst_pres_height_surface canonical_units: Pa - description: atmosphere export - instataneous pressure land and sea surface + description: atmosphere export - instantaneous pressure land and sea surface + # + - standard_name: Sa_ptem + canonical_units: K + description: atmosphere export - bottom layer potential temperature # - standard_name: Sa_shum alias: inst_spec_humid_height_lowest @@ -280,6 +284,10 @@ canonical_units: 1 description: sea-ice export - ice mask # + - standard_name: Si_qref + canonical_units: kg kg-1 + description: sea-ice export to atm + # - standard_name: Si_t alias: sea_ice_surface_temperature canonical_units: K @@ -299,6 +307,10 @@ description: sea-ice export volume of ice per unit area # + - standard_name: Si_snowh + canonical_units: m + description: sea-ice export - surface_snow_water_equivalent + # - standard_name: Si_vsno alias: mean_snow_volume canonical_units: m @@ -453,7 +465,6 @@ canonical_units: N m-2 description: ocean import - meridional surface stress to ocean # - # #----------------------------------- # mediator fields #----------------------------------- From 198e00ae97ec8877cf7acdc30162ad8950b824fb Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 1 Jul 2020 11:58:30 -0600 Subject: [PATCH 27/32] update Si_t alias for cesm + cice6 --- mediator/fd_cesm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 5c9199c47..423866cf8 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -684,7 +684,7 @@ description: sea-ice export to atm # - standard_name: Si_t - alias: sea_ice_temperature + alias: sea_ice_surfrace_temperature canonical_units: K description: sea-ice export # From 66cb2d8761caab6f36c90596435e153afcc12493 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 1 Jul 2020 14:14:58 -0600 Subject: [PATCH 28/32] spell surface correctly --- mediator/fd_cesm.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 423866cf8..d65f7c870 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -684,7 +684,7 @@ description: sea-ice export to atm # - standard_name: Si_t - alias: sea_ice_surfrace_temperature + alias: sea_ice_surface_temperature canonical_units: K description: sea-ice export # From 905e8e2ad64c3dd6bf8459eedd139f4e5878eb84 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sat, 4 Jul 2020 13:26:25 -0600 Subject: [PATCH 29/32] add entries to eliminate ifdefs in CICE6 nuopc cap --- mediator/fd_nems.yaml | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/mediator/fd_nems.yaml b/mediator/fd_nems.yaml index a92d94632..a74c483c9 100644 --- a/mediator/fd_nems.yaml +++ b/mediator/fd_nems.yaml @@ -43,6 +43,22 @@ # section: atmosphere export #----------------------------------- # + - standard_name: Faxa_bcph + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_dstdry + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_dstwet + canonical_units: kg m-2 s-1 + description: atmosphere export + # + #----------------------------------- + # section: atmosphere export + #----------------------------------- + # - standard_name: Faxa_swdn alias: mean_down_sw_flx canonical_units: W m-2 @@ -204,6 +220,18 @@ 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 @@ -214,6 +242,11 @@ 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_wiso + alias: mean_fresh_water_to_ocean_rate_wiso + canonical_units: kg m-2 s-1 + description: sea-ice export to ocean - fresh water to ocean (h2o flux from melting) for 16O, 18O, HDO + # - standard_name: Fioi_salt alias: mean_salt_rate canonical_units: kg m-2 s-1 From a2838cfd89c8cfdfc682a9db5fe543be66b9a644 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sun, 5 Jul 2020 17:48:28 -0600 Subject: [PATCH 30/32] changes required for CESM in med.F90. No answer changes are expected for NEMS but will rerun the tests to verify --- mediator/med.F90 | 263 +++++++++++++++++++++++------------------------ 1 file changed, 130 insertions(+), 133 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index acf1e509b..5769f84df 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1389,7 +1389,7 @@ subroutine completeFieldInitialization(State,rc) ! Convert grid to mesh if (.not. meshcreated) then if (dbug_flag > 20) then - call med_grid_write(grid, trim(fieldName)//'_premesh.nc', rc) + call med_grid_write(grid, trim(fieldName)//'_premesh.nc', rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -1510,6 +1510,7 @@ subroutine DataInitialize(gcomp, rc) ! local variables type(InternalState) :: is_local + type(ESMF_VM) :: vm type(ESMF_Clock) :: clock type(ESMF_State) :: importState, exportState type(ESMF_Time) :: time @@ -1525,10 +1526,8 @@ subroutine DataInitialize(gcomp, rc) 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 :: allDone = .false. + logical,save :: compDone(ncomps) logical,save :: first_call = .true. real(r8) :: real_nx, real_ny character(len=CX) :: msgString @@ -1819,11 +1818,46 @@ subroutine DataInitialize(gcomp, rc) call med_map_MapNorm_init(gcomp, logunit, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - first_call = .false. + !--------------------------------------- + ! Set the data initialize flag to false + !--------------------------------------- call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + !--------------------------------------- + ! Set the first call flag to false + !--------------------------------------- + + first_call = .false. + + !--------------------------------------- + ! *** Now return **** + !--------------------------------------- + + ! The Connectors are being "called" for the transfer of Meshes + ! (or Grids). However, being "called" can mean different + ! things! It can mean calling Initialization() phases, or Run() + ! phases. For most of the initialization hand-shake, only + ! Initialization() phases are called. This includes the entire + ! GeomTransfer protocol. However, ONLY the Run phase of a + ! Connector (full) transfers data AND timestamps! + + ! Once the first time DataInitialize() of CMEPS returns (below), + ! and NUOPC sees that its InitializeDataComplete is not yet + ! true, the NUOPC Driver will finally (for the first time!) + ! execute the Run() phase of all of the Connectors that fit the + ! *-TO-MED pattern. After that it will call CMEPS + ! DataInitialize() again. Note that the time stamps are only set + ! when the Run() phase of all the connectors are run. + + ! The Connectors Run() phase is called before the second call of + ! the CMEPS DataInitialize phase. As a result, CMEPS will see + ! the correct timestamps, which also indicates that the actual + ! data has been transferred reliably, and CMEPS can safely use it. + + RETURN + endif ! end first_call if-block !---------------------------------------------------------- @@ -1838,106 +1872,49 @@ subroutine DataInitialize(gcomp, rc) call med_fraction_set(gcomp,rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !--------------------------------------- - ! Carry out data dependency for initialization for NEMS - !--------------------------------------- - - if (trim(coupling_mode(1:4)) == 'nems') then - - ! check that all imported fields from ATM show correct timestamp - call ESMF_StateGet(is_local%wrap%NStateImp(compatm), itemCount=fieldCount, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(fieldNameList(fieldCount)) - call ESMF_StateGet(is_local%wrap%NStateImp(compatm), itemNameList=fieldNameList, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allDone = .true. - do n=1, fieldCount - call ESMF_StateGet(is_local%wrap%NStateImp(compatm), itemName=fieldNameList(n), field=field, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - atCorrectTime = NUOPC_IsAtTime(field, time, rc=rc) - if (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 (ChkErr(rc,__LINE__,u_FILE_u)) return - allDone = .false. - exit ! break out of the loop when first not satisfied found - endif - enddo - deallocate(fieldNameList) - - ! TOOD: this duplciates NEMS - but should the check be over all components - and not just atm + !---------------------------------------------------------- + ! Initialize ocean albedos (this is needed for cesm and hafs) + !---------------------------------------------------------- - if (allDone) then - ! set InitializeDataComplete Component Attribute to "true", indicating - ! to the driver that this Component has fully initialized its data - call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite("MED - Initialize-Data-Dependency allDone check Passed", ESMF_LOGMSG_INFO, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) - if (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 (trim(coupling_mode(1:5)) /= 'nems_') then + if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compatm)) then + call med_phases_ocnalb_run(gcomp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - end if !--------------------------------------- - ! Carry out data dependency for initialization for CESM + ! Loop over components and determine if they are at correct time !--------------------------------------- - if (trim(coupling_mode) == 'cesm') then - - 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) + do n1 = 1,ncomps + compDone(n1) = .true. ! even if component is not present + 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 (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(fieldNameList(fieldCount)) + call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemNameList=fieldNameList, rc=rc) + if (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 (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(fieldNameList(fieldCount)) - call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemNameList=fieldNameList, rc=rc) + atCorrectTime = NUOPC_IsAtTime(field, time, rc=rc) if (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 (ChkErr(rc,__LINE__,u_FILE_u)) return - atCorrectTime = NUOPC_IsAtTime(field, time, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (atCorrectTime) then - if (fieldNameList(n) == is_local%wrap%flds_scalar_name) then - call ESMF_LogWrite(trim(subname)//" MED - Initialize-Data-Dependency CSTI "//trim(compname(n1)), & - ESMF_LOGMSG_INFO, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif - else - LocalDone=.false. - endif - enddo - deallocate(fieldNameList) - - if (LocalDone) then - call ESMF_LogWrite(trim(subname)//" MED - Initialize-Data-Dependency Copy Import "//& - trim(compname(n1)), ESMF_LOGMSG_INFO, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (n1 == compocn) ocnDone = .true. - if (n1 == compatm) atmDone = .true. + if (.not. atCorrectTime) then + compDone(n1) = .false. endif - endif - enddo - - ! If ocn component is not present set ocnDone to true - if (.not. is_local%wrap%comp_present(compocn)) ocnDone = .true. - - ! If atm component is not present set ocnDone to true - if (.not. is_local%wrap%comp_present(compatm)) atmDone = .true. + enddo + deallocate(fieldNameList) + endif + enddo - if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compatm)) then - call med_phases_ocnalb_run(gcomp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + !--------------------------------------- + ! Carry out data dependency for atm initialization if needed + !--------------------------------------- - 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 + if (is_local%wrap%comp_present(compatm)) then + if (.not. compDone(compatm) .and. compDone(compocn)) then + compDone(compatm) = .true. ! reset if an item is found that is not done call ESMF_StateGet(is_local%wrap%NStateImp(compatm), itemCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(fieldNameList(fieldCount)) @@ -1949,16 +1926,21 @@ subroutine DataInitialize(gcomp, rc) atCorrectTime = NUOPC_IsAtTime(field, time, rc=rc) if (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 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 (ChkErr(rc,__LINE__,u_FILE_u)) return - atmdone = .false. + if (mastertask) then + write(logunit,'(A)') trim(subname)//"MED - Initialize-Data-Dependency from ATM NOT YET SATISFIED!!!" + end if + compDone(compatm) = .false. exit ! break out of the loop when first not satisfied found endif enddo deallocate(fieldNameList) - if (.not. atmdone) then ! atmdone is not true + if (.not. compDone(compatm)) then ! atmdone is not true ! do the merge to the atmospheric component call med_phases_prep_atm(gcomp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1982,52 +1964,50 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif endif + end if - ! Determine if allDone is true - 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 (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(fieldNameList(fieldCount)) - call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemNameList=fieldNameList, rc=rc) - if (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 (ChkErr(rc,__LINE__,u_FILE_u)) return - atCorrectTime = NUOPC_IsAtTime(field, time, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (.not. atCorrectTime) then - allDone=.false. - endif - enddo - deallocate(fieldNameList) - endif - enddo + !--------------------------------------- + ! Loop over components again and determine if all are at the correct time + !--------------------------------------- - if (allDone) then - ! set InitializeDataComplete Component Attribute to "true", indicating - ! to the driver that this Component has fully initialized its data - call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite("MED - Initialize-Data-Dependency allDone check Passed", ESMF_LOGMSG_INFO, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) + 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 (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) + allocate(fieldNameList(fieldCount)) + call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemNameList=fieldNameList, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - + do n=1, fieldCount + call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemName=fieldNameList(n), field=field, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + atCorrectTime = NUOPC_IsAtTime(field, time, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (.not. atCorrectTime) then + allDone=.false. + if (mastertask) then + write(logunit,'(A)') trim(subname)//" MED - Initialize-Data-Dependency check Failed for "//& + trim(compname(n1)) + end if + endif + enddo + deallocate(fieldNameList) + endif + enddo + if (allDone) then + ! set InitializeDataComplete Component Attribute to "true", indicating + ! to the driver that this Component has fully initialized its data + call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite("MED - Initialize-Data-Dependency allDone check Passed", ESMF_LOGMSG_INFO, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if !--------------------------------------- - ! Data dependency is successfully completed + ! Create component dimensions in mediator internal state !--------------------------------------- if (allDone) then - ! Create component dimensions in mediator internal state if (mastertask) write(logunit,*) do n1 = 1,ncomps if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then @@ -2052,20 +2032,37 @@ subroutine DataInitialize(gcomp, rc) end do if (mastertask) write(logunit,*) + !--------------------------------------- ! Initialize mediator IO + !--------------------------------------- + call med_io_init() + !--------------------------------------- ! read mediator restarts + !--------------------------------------- + call NUOPC_CompAttributeGet(gcomp, name="read_restart", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//' read_restart = '//trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) read_restart + if (read_restart) then call med_phases_restart_read(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif call med_phases_profile(gcomp, rc) + + else ! Not all done + call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) + if (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 (ChkErr(rc,__LINE__,u_FILE_u)) return + end if if (profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) From 2e18eb8b73f2173727937a9c59b3e99f6b219efc Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Wed, 8 Jul 2020 12:09:58 -0400 Subject: [PATCH 31/32] update mediator/Makefile to compile esmf 8.1.0 (#12) Authored-by: Jun Wang --- mediator/Makefile | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/mediator/Makefile b/mediator/Makefile index fae000dae..d40272a19 100644 --- a/mediator/Makefile +++ b/mediator/Makefile @@ -3,13 +3,14 @@ $(error Environment variable ESMFMKFILE was not set.) endif include $(ESMFMKFILE) +CPPDEFS += -DESMF_VERSION_MAJOR=$(ESMF_VERSION_MAJOR) -DESMF_VERSION_MINOR=$(ESMF_VERSION_MINOR) ifndef PIO_INCLUDE_DIR $(error PIO_INCLUDE_DIR not set) endif ifdef INTERNAL_PIO_INIT -CPPDEFS := -DINTERNAL_PIO_INIT +CPPDEFS += -DINTERNAL_PIO_INIT endif LIBRARY := libcmeps.a From 318e4419bee374bacd7d5329ff3332aa70e42019 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 9 Jul 2020 09:39:37 -0400 Subject: [PATCH 32/32] Revert "update mediator/Makefile to compile esmf 8.1.0 (#12)" This reverts commit 2e18eb8b73f2173727937a9c59b3e99f6b219efc. --- mediator/Makefile | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/mediator/Makefile b/mediator/Makefile index d40272a19..fae000dae 100644 --- a/mediator/Makefile +++ b/mediator/Makefile @@ -3,14 +3,13 @@ $(error Environment variable ESMFMKFILE was not set.) endif include $(ESMFMKFILE) -CPPDEFS += -DESMF_VERSION_MAJOR=$(ESMF_VERSION_MAJOR) -DESMF_VERSION_MINOR=$(ESMF_VERSION_MINOR) ifndef PIO_INCLUDE_DIR $(error PIO_INCLUDE_DIR not set) endif ifdef INTERNAL_PIO_INIT -CPPDEFS += -DINTERNAL_PIO_INIT +CPPDEFS := -DINTERNAL_PIO_INIT endif LIBRARY := libcmeps.a