diff --git a/cime_config/buildnml b/cime_config/buildnml index ea845c84c..a133e1dff 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -37,11 +37,14 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config["CPL_I2O_PER_CAT"] = case.get_value("CPL_I2O_PER_CAT") config["DRV_THREADING"] = case.get_value("DRV_THREADING") config["CPL_ALBAV"] = case.get_value("CPL_ALBAV") + config["CPL_EPBAL"] = case.get_value("CPL_EPBAL") config["BUDGETS"] = case.get_value("BUDGETS") config["MACH"] = case.get_value("MACH") config["MPILIB"] = case.get_value("MPILIB") config["OS"] = case.get_value("OS") config["TESTCASE"] = case.get_value("TESTCASE") + config["ocn_multilev"] = ".false." + config["set_histaux_l2x1yrg"] = ".false." if not config["TESTCASE"]: config["TESTCASE"] = "UNSET" config["glc_nec"] = ( @@ -53,9 +56,14 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): for val in ("HIST", "REST", "STOP"): config[val.lower()+"_option"] = case.get_value(val+"_OPTION") - config["comp_ocn"] = case.get_value("COMP_OCN") + config["set_histaux_l2x1yrg"] = ( + ".true." if case.get_value("COMP_OCN") == 'blom' and case.get_value("COMP_LND") == 'clm' else ".false." + ) + config["ocn_multilev"] = ( + ".true." if case.get_value("COMP_OCN") == 'blom' or 'DOCN%MULTILEV' in case.get_value("COMPSET") else ".false." + ) atm_grid = case.get_value("ATM_GRID") lnd_grid = case.get_value("LND_GRID") @@ -122,11 +130,29 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): elif case.get_value("RUN_TYPE") == "branch": config["run_type"] = "branch" + # For a branch run the driver must read the reference case's restart, so + # the driver restart pointer must be set explicitly to the dated + # rpointer.cpl of that reference case. buildnml does not modify xml + # variables, so rather than set DRV_RESTART_POINTER we check that it + # matches the expected dated pointer (built from RUN_REFDATE and + # RUN_REFTOD) and, if not, fail with the exact xmlchange command needed. + # (On a continue run CIME sets DRV_RESTART_POINTER automatically, and a + # hybrid run does not read the driver restart, so neither is checked.) + if not case.get_value("CONTINUE_RUN"): + expected_pointer = "rpointer.cpl.{}-{}".format( + case.get_value("RUN_REFDATE"), case.get_value("RUN_REFTOD") + ) + expect( + case.get_value("DRV_RESTART_POINTER") == expected_pointer, + "For a branch run the driver restart pointer must be set to the " + "dated rpointer.cpl of the reference case. Set it with:\n" + " ./xmlchange DRV_RESTART_POINTER={}".format(expected_pointer), + ) + # determine coupling mode config["coupling_mode"] = case.get_value("COUPLING_MODE") # determine wav_ice_coupling - config["wav_ice_coupling"] = "off" if config["coupling_mode"] == "cesm" or config["coupling_mode"] == "noresm": if config['COMP_WAV'] == 'ww3' and config['COMP_ICE'] == 'cice': config["wav_ice_coupling"] = "on" @@ -143,6 +169,15 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): # ---------------------------------------------------- nmlgen.init_defaults(infile, config, skip_default_for_groups=["modelio"]) + # ---------------------------------------------------- + # Error checks + # ---------------------------------------------------- + # double check if ocn2glc_coupling is set correctly + ocn2glc_coupling = nmlgen.get_value("ocn2glc_coupling") + if ocn2glc_coupling == ".true.": + expect(case.get_value("COMP_OCN") == 'blom' or 'DOCN%MULTILEV' in case.get_value("COMPSET"), + "ocn2glc_coupling is only allowed currently if the ocean component is BLOM or if DOCN%MULTILEV is in the compset") + # -------------------------------- # Overwrite: set brnch_retain_casename # -------------------------------- @@ -238,6 +273,24 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): run_startdate = "".join(str(x) for x in case.get_value("RUN_STARTDATE").split("-")) nmlgen.set_value("start_ymd", value=run_startdate) + # -------------------------------- + # Overwrite: budget_table_version if atm computes enthalpy + # -------------------------------- + component_computes_enthalpy_flux = nmlgen.get_value("component_computes_enthalpy_flux") + if 'atm' in component_computes_enthalpy_flux: + nmlgen.set_value("budget_table_version", value="v2") + expect( + case.get_value("COMP_ATM") != "cam" and + case.get_value("COMP_OCN") == "mom6", + "Only CAM and BLOM are currently allowed if cam computes enthalpy fluxes" + ) + elif component_computes_enthalpy_flux == "med": + expect( + case.get_value("COMP_ATM") != "cam" and + case.get_value("COMP_OCN") != "mom6", + "Only CAM and MOM6 are currently allowed if mediator computes enthalpy fluxes" + ) + # -------------------------------- # Overwrite: set tprof_option and tprof_n - if tprof_total is > 0 # -------------------------------- @@ -552,6 +605,65 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): drv_flds_in = os.path.join(caseroot, "CaseDocs", "drv_flds_in") nmlgen.write_output_file(drv_flds_in) + # now read drv_flds_in and determine if lnd sends extra + # non-water tracers to runoff component + add_tracer_field = False + with open(drv_flds_in, "r", encoding="utf-8") as namelist_file: + for line in namelist_file.readlines(): + if 'lnd2rof_tracers' in line and 'lnd2rof_tracers_inparm' not in line: + add_tracer_field = True + + append_line = False + if add_tracer_field: + user_nl_cpl = os.path.join(caseroot, "user_nl_cpl") + append_line = True + with open(user_nl_cpl) as user_file: + for line in user_file.readlines(): + if 'Flrl_rofsur_nonh2o' in line: + append_line = False + if append_line: + print("NOTE: Adding the following line to user_nl_cpl") + print( "histaux_lnd2med_file2_flds = \'Flrl_rofsur:Flrl_rofi:Flrl_rofgwl:Flrl_rofsub:Flrl_rofsur_nonh2o\'\n") + with open(user_nl_cpl, 'a') as user_file: + user_file.write("histaux_lnd2med_file2_flds = \'Flrl_rofsur:Flrl_rofi:Flrl_rofgwl:Flrl_rofsub:Flrl_rofsur_nonh2o\'\n") + +############################################################################### +def _add_water_tracers(water_tracers_xml, nmlgen): + ############################################################################### + + if not water_tracers_xml.strip(): + water_tracers = [] + else: + water_tracers = water_tracers_xml.split(":") + tracer_names = [] + tracer_species = [] + tracer_initial_ratios = [] + + for tracer in water_tracers: + # Each item in the list consists of a name and then, optionally, a '%' followed by + # the isotope species for this tracer. For standard water tracers (i.e., tracers + # of bulk water), the list item will only contain the name (without a '%'). + expect( + tracer.count("%") <= 1, + f"Invalid WATER_TRACERS element, '{tracer}': Each element of WATER_TRACERS must contain at most 1 '%' separator", + ) + parts = tracer.split("%") + tracer_names.append(parts[0]) + if len(parts) > 1: + tracer_species.append(parts[1]) + # We could check the validity of the species name here (confirming that it's + # one of the handled species), but that would lead to this allowed list being + # replicated in multiple places (here as well as in the Fortran), which would + # make it more difficult to add new species later. So we're deferring this + # check to runtime. + else: + tracer_species.append("-") + tracer_initial_ratios.append("1.0") + + nmlgen.add_default("water_tracer_names", ":".join(tracer_names)) + nmlgen.add_default("water_tracer_species", ":".join(tracer_species)) + nmlgen.add_default("water_tracer_initial_ratios", ":".join(tracer_initial_ratios)) + ############################################################################### def _add_water_tracers(water_tracers_xml, nmlgen): diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 7bb614873..b72db91f1 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -38,7 +38,7 @@ char cesm,noresm - cesm + noresm run_coupling env_run.xml coupling mode @@ -1412,10 +1412,7 @@ idmap run_domain env_run.xml - lnd2rof flux (conservative) mapping file. (This mapping file is used for both consd and consf mappings; as discussed in - https://github.com/ESCOMP/CMEPS/issues/408, the results of these two mappings are the same within roundoff in CMEPS due to the - normalization that is done when applying the mapping weights. For simplicity, and because land mesh files generally don't have - a mask, this mapping file should be generated with '--norm_type dstarea'.) + lnd2rof flux mapping file diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index d5411905d..64ab48246 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -122,7 +122,7 @@ Activates additional CO2-related fields to be exchanged between components. Possible values are: CO2A: sets the driver namelist variable flds_co2a = .true.; this adds - prognostic CO2 and diagnostic CO2 at the lowest model level to be sent from + diagnostic CO2 at the lowest model level to be sent from the atmosphere to the land and ocean. CO2B: sets the driver namelist variable flds_co2b = .true.; this adds @@ -301,7 +301,14 @@ 24 + 18 48 + + + + 72 + 72 + run_coupling env_run.xml @@ -342,6 +349,9 @@ 24 24 + 18 + + 24 1 24 diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 7d322375e..0a3768f1d 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -347,7 +347,7 @@ nuopc ALLCOMP_attributes - cmeps + cesm @@ -605,7 +605,8 @@ .true. if ocean sends fields at multiple ocean levels to the land-ice component - .false. + .false. + .true. @@ -661,6 +662,26 @@ + + + + + + char + control + ALLCOMP_attributes + none,atm,med + + if none, no enthaply flux is computed to send to the ocean, + if atm, the atm (in this case cam) computes enthalpy to send to the ocn (in this case BLOM) + if med, the mediator computes computes enthalpy to send to the ocn (in this case MOM6) + + + none + med + + + @@ -913,6 +934,20 @@ + + integer + control + MED_attributes + + Ocean albedo scheme + 0 : Briegleb et al. (1986) + 1 : Taylor et al. (1996) + + + 1 + + + char mapping @@ -943,6 +978,7 @@ 0 + 1 @@ -956,8 +992,8 @@ (Currently only relevant for ocn_surface_flux_scheme = 0 or 1.) - .true. .false. + .true. @@ -990,14 +1026,13 @@ char budget MED_attributes - v0,v1 + v0,v1,v2 - currently v0 refers to budgets using POP and v1 refers to budgets using MOM6 + currently v0 refers to budgets using BLOM and v1 refers to budgets using MOM6 v0 v1 - v0 @@ -1805,7 +1840,71 @@ - + + + logical + aux_hist + MED_attributes + Auxiliary mediator l2x fields every lnd coupling interval + + .false. + + + + char + aux_hist + MED_attributes + Auxiliary mediator lnd2med output every lnd coupling interval + + 'Flrl_rofsur:Flrl_rofi:Flrl_rofgwl:Flrl_rofsub' + + + + char + aux_hist + MED_attributes + history option type + + ndays + + + + integer + aux_hist + MED_attributes + history option type + + 1 + + + + logical + aux_hist + MED_attributes + If true, use time average for aux file output. + + .true. + + + + integer + aux_hist + MED_attributes + Number of time samples per file. + + 365 + + + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + lnd2rof.24hr.avg + + + @@ -1815,7 +1914,8 @@ ALLCOMP_attributes Auxiliary mediator lnd2med fields every year - .false. + .true. + .false. @@ -2124,7 +2224,7 @@ aux_hist MED_attributes - + "" Sw_hs_avg:Sw_Tm1_avg:Sw_thm_avg:Sw_u_avg:Sw_v_avg:Sw_ustokes_avg:Sw_vstokes_avg:Sw_tusx_avg:Sw_tusy_avg:Sw_thp0_avg:Sw_fp0_avg:Sw_phs0_avg:Sw_phs1_avg:Sw_pdir0_avg:Sw_pdir1_avg:Sw_pTm10_avg:Sw_pTm11_avg Sw_Hs:Sw_t01:Sw_t0m1:Sw_thm:Sw_lamult:Sw_ustokes:Sw_vstokes @@ -2268,10 +2368,7 @@ mapping abs MED_attributes - lnd2rof flux (conservative) mapping file; 'unset' or 'idmap' are normal possible values. (This mapping file is used for both - consd and consf mappings; as discussed in https://github.com/ESCOMP/CMEPS/issues/408, the results of these two mappings are the - same within roundoff in CMEPS due to the normalization that is done when applying the mapping weights. For simplicity, and because - land mesh files generally don't have a mask, this mapping file should be generated with '--norm_type dstarea'.) + lnd to rof mapping, 'unset' or 'idmap' are normal possible values (mapping file given for mizuRoute grids) $LND2ROF_FMAPNAME idmap @@ -2421,10 +2518,9 @@ expdef ALLCOMP_attributes - index of scalar containing epbal precipitation factor from ocn (only for POP) + index of scalar containing epbal precipitation factor from ocn (only for BLOM) - 4 4 0 @@ -2648,22 +2744,6 @@ - - char - water_tracers - ALLCOMP_attributes - - Colon-delimited list of variables for which water tracer consistency checks should be skipped. - - Each entry must match the variable name passed to shr_wtracers_check_tracer_ratios. - For checks of mediator fields, these are of the form FieldBundleName%FieldName. - For example: "FBImpatm%Sa_shum_wtracers:FBExprof%Flrl_irrig_wtracers". - - - - - - @@ -4020,6 +4100,18 @@ $ICE_DOMAIN_MESH + + real + mapping + ICE_attributes + + Maximum allowed mesh error + + + 0.1 + 0.15 + + diff --git a/cime_config/namelist_definition_drv_flds.xml b/cime_config/namelist_definition_drv_flds.xml index 4d4ab1ec3..e78f682eb 100644 --- a/cime_config/namelist_definition_drv_flds.xml +++ b/cime_config/namelist_definition_drv_flds.xml @@ -123,7 +123,7 @@ Fire_emissions fire_emis_nl - If ture fire emissions are input into atmosphere as elevated forcings. + If true, fire emissions are input into atmosphere as elevated forcings. Otherwise they are treated as surface emissions. @@ -141,6 +141,19 @@ + + + + + + char + lnd2rof_tracers + lnd2rof_tracers_inparm + + Colon deliminted string of Liquid non-water tracers sent from land to river + + + diff --git a/cime_config/runseq/runseq_TG.py b/cime_config/runseq/runseq_TG.py index acf56a87b..2410f870b 100644 --- a/cime_config/runseq/runseq_TG.py +++ b/cime_config/runseq/runseq_TG.py @@ -15,8 +15,9 @@ def gen_runseq(case, coupling_times): - rundir = case.get_value("RUNDIR") - caseroot = case.get_value("CASEROOT") + rundir = case.get_value("RUNDIR") + caseroot = case.get_value("CASEROOT") + comp_ocn = case.get_value("COMP_OCN") driver_config = DriverConfig(case, coupling_times) run_glc, med_to_glc, glc_cpl_time = driver_config['glc'] @@ -32,9 +33,15 @@ def gen_runseq(case, coupling_times): runseq.add_action ("LND" , run_lnd) runseq.add_action ("LND -> MED :remapMethod=redist" , run_lnd) runseq.add_action ("MED med_phases_post_lnd" , run_lnd) + if (comp_ocn == 'docn'): + runseq.add_action ("OCN" , run_lnd) + runseq.add_action ("OCN -> MED :remapMethod=redist" , run_lnd) + runseq.add_action ("MED med_phases_post_ocn" , run_lnd) runseq.add_action ("MED med_phases_prep_glc" , med_to_glc) runseq.add_action ("MED -> GLC :remapMethod=redist" , med_to_glc) runseq.add_action ("GLC" , run_glc) + + # Need to do GLC -> MED even if not running GLC; otherwise, we get a # failure in InitializeRealize ("Object being used before creation") runseq.add_action ("GLC -> MED :remapMethod=redist" , med_to_glc) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 9ef0b786d..775f7ef55 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -64,6 +64,7 @@ module esmFldsExchange_cesm_mod use med_internalstate_mod , only : mrg_fracname_lnd2rof, map_fracname_lnd2rof use med_internalstate_mod , only : mrg_fracname_lnd2glc, map_fracname_lnd2glc use med_utils_mod , only : chkerr => med_utils_chkerr + use med_internalstate_mod , only : coupling_mode use shr_log_mod , only : shr_log_error use wtracers_mod , only : wtracers_present use wtracers_mod , only : WTRACERS_SUFFIX @@ -1210,6 +1211,17 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if end if + if (trim(coupling_mode) == 'noresm') then + if (phase == 'advertise') then + call addfld_to(compatm, 'Faox_evap'//trim(suffix)) + else + if (fldchk(is_local%wrap%FBexp(compatm), 'Faox_evap'//trim(suffix), rc=rc)) then + ! unmerged aoflux-only for correct hevap to ocean in cam_out + call addmrg_to(compatm, 'Faox_evap'//trim(suffix), & + mrg_from=compmed, mrg_fld='Faox_evap'//trim(suffix), mrg_type='copy') + end if + end if + end if end do if (phase == 'advertise') then @@ -1731,22 +1743,39 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if ! --------------------------------------------------------------------- - ! to ocn: merged longwave net heat flux + ! to ocn: merged longwave net heat flux (cesm) ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm , 'Faxa_lwdn') - call addfld_aoflux('Faox_lwup' ) - call addfld_to(compocn , 'Foxx_lwnet') - else - ! (mom6) (send longwave net to ocn via auto merge) - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_lwnet', rc=rc) .and. & - fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_lwup' , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn' , rc=rc)) then - call addmap_from(compatm, 'Faxa_lwdn', compocn, mapconsf, 'one' , atm2ocn_map) - call addmrg_to(compocn, 'Foxx_lwnet', & - mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') - call addmrg_to(compocn, 'Foxx_lwnet', & - mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='merge', mrg_fracname='ofrac') + if (trim(coupling_mode) == 'cesm') then + if (phase == 'advertise') then + call addfld_from(compatm , 'Faxa_lwdn') + call addfld_aoflux('Faox_lwup' ) + call addfld_to(compocn , 'Foxx_lwnet') + else + ! (mom6) (send longwave net to ocn via auto merge) + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_lwnet', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_lwup' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn' , rc=rc)) then + call addmap_from(compatm, 'Faxa_lwdn', compocn, mapconsf, 'one' , atm2ocn_map) + call addmrg_to(compocn, 'Foxx_lwnet', & + mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') + call addmrg_to(compocn, 'Foxx_lwnet', & + mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if + ! --------------------------------------------------------------------- + ! to ocn: longwave down from atm (noresm) + ! --------------------------------------------------------------------- + if (trim(coupling_mode) == 'noresm') then + if (phase == 'advertise') then + call addfld_from(compatm, 'Faxa_lwdn') + call addfld_to(complnd, 'Faxa_lwdn') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_lwdn', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_lwdn', rc=rc)) then + call addmap_from(compatm, 'Faxa_lwdn', complnd, mapconsf, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Faxa_lwdn', mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='copy') + end if end if end if ! --------------------------------------------------------------------- @@ -1763,6 +1792,35 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) mrg_from=compatm, mrg_fld='Faxa_swdn', mrg_type='copy') end if end if + !---------------------------------------------------------------------- + ! to ocn: downward material enthalpy flux from atm + ! --------------------------------------------------------------------- + if (trim(coupling_mode) == 'noresm') then + if (phase == 'advertise') then + call addfld_from(compatm, 'Faxa_hmat') + call addfld_to (compocn, 'Faxa_hmat') + call addfld_to (compocn, 'Faxa_hmat_oa') ! handled in prep_ocn + call addfld_from(compatm, 'Faxa_hlat') + call addfld_to (compocn, 'Faxa_hlat') + call addfld_to (compatm, 'Faxx_hrof') ! enthalpy of runoff, computed in med_phases_prep_ocn + else + if (fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_hmat', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_hmat', rc=rc)) then + call addmap_from(compatm, 'Faxa_hmat', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to (compocn, 'Faxa_hmat', mrg_from=compatm ,mrg_fld='Faxa_hmat' & + , mrg_type='copy_with_weights', mrg_fracname='ofrac') + end if + if (fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_hlat', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_hlat', rc=rc)) then + call addmap_from(compatm, 'Faxa_hlat', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to (compocn, 'Faxa_hlat', mrg_from=compatm ,mrg_fld='Faxa_hlat' & + , mrg_type='copy_with_weights', mrg_fracname='ofrac') + end if + !if (fldchk(is_local%wrap%FBExp(compatm),'Faxx_hrof', rc=rc)) & + ! call addmap_from(compocn, 'Faxx_hrof', compatm, mapconsf, 'one', atm2ocn_map) + end if + end if + ! --------------------------------------------------------------------- ! to ocn: net shortwave radiation from med ! --------------------------------------------------------------------- @@ -1803,15 +1861,15 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if ! import sw from atm by bands - if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdr', rc=rc) .and. & + if ((fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndr', rc=rc) .and. & - (fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet' , rc=rc)) .or. & - (fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', rc=rc))) then + fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_swnet', rc=rc)) .or. & + (fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', rc=rc))) then call addmap_from(compatm, 'Faxa_swvdr', compocn, mapconsf, 'one', atm2ocn_map) call addmap_from(compatm, 'Faxa_swvdf', compocn, mapconsf, 'one', atm2ocn_map) call addmap_from(compatm, 'Faxa_swndr', compocn, mapconsf, 'one', atm2ocn_map) @@ -2210,6 +2268,23 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: waterflux back to ocn due to flooding from rof !----------------------------- + if (trim(coupling_mode) == 'noresm') then + if (phase == 'advertise') then + call addfld_from(comprof, 'Forr_rofl_nonh2o') + call addfld_to(compocn, 'Forr_rofl_nonh2o') + else + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_nonh2o' , rc=rc)) then + if ( fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_nonh2o' , rc=rc)) then + if (trim(rof2ocn_liq_rmap) == 'unset') then + call addmap_from(comprof, 'Forr_rofl_nonh2o', compocn, mapconsd, 'one', 'unset') + else + call addmap_from(comprof, 'Forr_rofl_nonh2o', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) + end if + end if + end if + end if + end if + do water_bulk_or_tracers_index = 1, water_bulk_or_tracers_max call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2335,11 +2410,22 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_from(compwav, 'Sw_Tm1_avg') call addfld_from(compwav, 'Sw_thm_avg') call addfld_from(compwav, 'Sw_thp0_avg') + call addfld_from(compwav, 'Sw_faw_avg') call addfld_from(compwav, 'Sw_fp0_avg') call addfld_from(compwav, 'Sw_u_avg') call addfld_from(compwav, 'Sw_v_avg') + call addfld_from(compwav, 'Sw_cu_avg') + call addfld_from(compwav, 'Sw_cv_avg') call addfld_from(compwav, 'Sw_tusx_avg') call addfld_from(compwav, 'Sw_tusy_avg') + call addfld_from(compwav, 'Sw_lamult_avg') + call addfld_from(compwav, 'Sw_charn_avg') + call addfld_from(compwav, 'Sw_tm02_avg') + call addfld_from(compwav, 'Sw_foc_avg') + call addfld_from(compwav, 'Sw_ifrac_avg') + call addfld_from(compwav, 'Sw_thick_avg') + call addfld_from(compwav, 'Sw_tauicex_avg') + call addfld_from(compwav, 'Sw_tauicey_avg') end if !----------------------------- @@ -2394,7 +2480,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap_from(compwav, 'Sw_t0m1', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_t0m1', mrg_from=compwav, mrg_fld='Sw_t0m1', mrg_type='copy') end if - end if + end if !----------------------------- ! to ocn: !----------------------------- @@ -2407,7 +2493,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap_from(compwav, 'Sw_t01', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_t01', mrg_from=compwav, mrg_fld='Sw_t01', mrg_type='copy') end if - end if + end if !----------------------------- ! to ocn: !----------------------------- @@ -2420,7 +2506,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap_from(compwav, 'Sw_thm', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_thm', mrg_from=compwav, mrg_fld='Sw_thm', mrg_type='copy') end if - end if + end if !----------------------------- ! to ocn: !----------------------------- @@ -3328,6 +3414,23 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end do + ! --------------------------------------------------------------------- + ! to rof: non-water flux(es) from land (liquid surface) + ! --------------------------------------------------------------------- + if (trim(coupling_mode) == 'noresm') then + if (phase == 'advertise') then + call addfld_from(complnd, 'Flrl_rofsur_nonh2o') + call addfld_to(comprof, 'Flrl_rofsur_nonh2o') + else + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsur_nonh2o', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsur_nonh2o', rc=rc)) then + call addmap_from(complnd, 'Flrl_rofsur_nonh2o', comprof, mapconsf, map_fracname_lnd2rof, lnd2rof_map) + call addmrg_to(comprof, 'Flrl_rofsur_nonh2o', & + mrg_from=complnd, mrg_fld='Flrl_rofsur_nonh2o', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) + end if + end if + end if + ! --------------------------------------------------------------------- ! to rof: water flux from land (ice surface) ! --------------------------------------------------------------------- diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 2a22fc824..bf59c9b02 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -75,12 +75,12 @@ - standard_name: Fwxx_taux alias: mean_zonal_moment_flx canonical_units: N m-2 - description: wave import to med - zonal surface stress + description: med export - zonal surface stress to wave computed in mediator # - standard_name: Fwxx_tauy alias: mean_merid_moment_flx canonical_units: N m-2 - description: wave import to med - meridional surface stress + description: med export - meridional surface stress to wave computed in mediator # #----------------------------------- # section: lnd import to med @@ -230,6 +230,10 @@ canonical_units: kg m-2 s-1 description: lnd export to river # + - standard_name: Flrl_rofsur_nonh2o + canonical_units: kg m-2 s-1 + description: lnd export to river for non-water liquid tracers + # - standard_name: Flrl_rofsur_wtracers canonical_units: kg m-2 s-1 description: lnd export to river @@ -316,7 +320,25 @@ alias: mean_down_lw_flx canonical_units: W m-2 description: atm import to med - mean downward SW heat flux + mean downward LW heat flux + # + - standard_name: Faxa_hmat + alias: mean_down_hmat + canonical_units: W m-2 + description: atm import to med + mean downward material enthalpy flux + # + - standard_name: Faxa_hlat + alias: mean_down_hlat + canonical_units: W m-2 + description: atm import to med + variable latent heat part of mat.enth.flx + # + - standard_name: Faxa_hmat_oa + alias: mean_down_hmat_oa + canonical_units: W m-2 + description: med export to ocn + mean downw. mat. enth. flux, ocean average # - standard_name: Faxa_ndep canonical_units: kg(N)/m2/sec @@ -1032,6 +1054,11 @@ canonical_units: W m-2 description: med export to ocn heat content of condensation # + - standard_name: Faxx_hrof + alias: heat_content_rof + canonical_units: W m-2 + description: med export to atm gl.avg. of mat.enthalpy of runoff + # - standard_name: Foxx_hrofl alias: heat_content_rofl canonical_units: W m-2 @@ -1219,7 +1246,11 @@ # - standard_name: Forr_rofl canonical_units: kg m-2 s-1 - description: river import to med - water flux due to runoff (liquid) + description: river import to med - liquid water flux due to runoff + # + - standard_name: Forr_rofl_nonh2o + canonical_units: kg m-2 s-1 + description: river import to med - non-water flux due to runoff # - standard_name: Forr_rofl_wtracers canonical_units: kg m-2 s-1 @@ -1229,6 +1260,10 @@ canonical_units: kg m-2 s-1 description: river import to med - water flux due to runoff originating from glc (liquid) # + - standard_name: Forr_rofl_nonh2o + canonical_units: kg m-2 s-1 + description: river import to med - non-water flux(es) due to runoff originating from lnd (liquid) + # - standard_name: Forr_rofl_glc_wtracers canonical_units: kg m-2 s-1 description: river import to med - water tracer flux due to runoff originating from glc (liquid) @@ -1340,68 +1375,113 @@ # - standard_name: Sw_ustokes_avg canonical_units: m/s - description: Daily averaged stokes drift u component (only needed for med history output) + description: Daily averaged stokes drift u component (only needed for mediator history output) # - standard_name: Sw_vstokes_avg canonical_units: m/s - description: Daily averaged stokes drift v component (only needed for med history output) + description: Daily averaged stokes drift v component (only needed for mediator history output) # - standard_name: Sw_hs_avg canonical_units: m - description: Daily averaged significant wave hight (only needed for med history output) + description: Daily averaged significant wave hight (only needed for mediator history output) # - standard_name: Sw_phs0_avg canonical_units: m - description: Daily averaged averaged wind sea swh (only needed for med history output) + description: Daily averaged averaged wind sea swh (only needed for mediator history output) # - standard_name: Sw_phs1_avg canonical_units: m - description: Daily averaged swell swh (only needed for med history output) + description: Daily averaged swell swh (only needed for mediator history output) # - standard_name: Sw_pdir0_avg canonical_units: degrees - description: Daily averaged wind sea swh (only needed for med history output) + description: Daily averaged wind sea swh (only needed for mediator history output) # - standard_name: Sw_pdir1_avg canonical_units: degrees - description: Daily averaged swell swh (only needed for med history output) + description: Daily averaged swell swh (only needed for mediator history output) # - standard_name: Sw_pTm10_avg canonical_units: s - description: Daily averaged wind sea mean wave Tm1 period (only needed for med history output) + description: Daily averaged wind sea mean wave Tm1 period (only needed for mediator history output) # - standard_name: Sw_pTm11_avg canonical_units: s - description: Daily average swell mean wave Tm1 period (only needed for med history output) + description: Daily average swell mean wave Tm1 period (only needed for mediator history output) # - standard_name: Sw_Tm1_avg canonical_units: s - description: Daily averaged mean wave period of the first moment (only needed for med history output) + description: Daily averaged mean wave period of the first moment (only needed for mediator history output) # - standard_name: Sw_thm_avg canonical_units: degrees - description: Daily averaged mean wave direction (only needed for med history output) + description: Daily averaged mean wave direction (only needed for mediator history output) # - standard_name: Sw_thp0_avg canonical_units: degrees - description: Daily averaged peak wave direction (only needed for med history output) + description: Daily averaged peak wave direction (only needed for mediator history output) # - standard_name: Sw_fp0_avg canonical_units: 1/s - description: Daily averaged peak wave frequency (only needed for med history output) + description: Daily averaged peak wave frequency (only needed for mediator history output) # - standard_name: Sw_u_avg canonical_units: m/s - description: Daily averaged surface wind zonal (only needed for med history output) + description: Daily averaged surface wind zonal (only needed for mediator history output) # - standard_name: Sw_v_avg canonical_units: m/s - description: Daily averaged surface wind meridional (only needed for med history output) + description: Daily averaged surface wind meridional (only needed for mediator history output) + # + - standard_name: Sw_cu_avg + canonical_units: m/s + description: Daily averaged surface zonal current(only needed for mediator history output) + # + - standard_name: Sw_cv_avg + canonical_units: m/s + description: Daily averaged surface meridional current (only needed for mediator history output) # - standard_name: Sw_tusx_avg canonical_units: m2/s - description: Daily averaged stokes zonal transport vector (only needed for med history output) + description: Daily averaged stokes zonal transport vector (only needed for mediator history output) # - standard_name: Sw_tusy_avg canonical_units: m2/s - description: Daily averaged stokes meridional transport vector (only needed for med history output) + description: Daily averaged stokes meridional transport vector (only needed for mediator history output) + # + - standard_name: Sw_lamult_avg + canonical_units: 1 + description: Daily averaged Langmuir number (only needed for mediator history output) + # + - standard_name: Sw_charn_avg + canonical_units: 1 + description: Daily averaged Charnock parameter (only needed for mediator history output) + # + - standard_name: Sw_tm02_avg + canonical_units: s + alias: Total_m2-period + description: Daily averaged mean wave period of the second moment (only needed for mediator history output) + # + - standard_name: Sw_foc_avg + canonical_units: W/m3 + description: Daily averaged wave to ocean energy flux (only needed for mediator history output) + # + - standard_name: Sw_faw_avg + canonical_units: W/m3 + description: Daily averaged wind to wave energy flux (only needed for mediator history output) + # + - standard_name: Sw_ifrac_avg + canonical_units: 1 + description: Daily averaged sea ice concentration (only needed for mediator history output) + # + - standard_name: Sw_thick_avg + canonical_units: m + description: Daily averaged sea ice thickness (only needed for mediator history output) + # + - standard_name: Sw_tauicex_avg + canonical_units: m2/s2 + description: Daily averaged x component of momentum flux to sea ice (only needed for mediator history output) + # + - standard_name: Sw_tauicey_avg + canonical_units: m2/s2 + description: Daily averaged y component of momentum flux to sea ice (only needed for mediator history output) diff --git a/mediator/med.F90 b/mediator/med.F90 index 2ea432cb1..48ad9c49d 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -57,7 +57,6 @@ module MED use med_ufs_trace_wrapper_mod, only : ufs_trace_init_wrapper, ufs_trace_wrapper, ufs_trace_finalize_wrapper - implicit none private @@ -1972,7 +1971,7 @@ subroutine DataInitialize(gcomp, rc) !--------------------------------------- ! Initialize rof module field bundles here if appropriate !--------------------------------------- - if (is_local%wrap%med_coupling_active(comprof,complnd)) then + if (is_local%wrap%med_coupling_active(complnd,comprof)) then call med_phases_prep_rof_init(gcomp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 787202db6..17a6617b3 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -152,6 +152,8 @@ module med_diag_mod integer :: f_heat_rofl_glc = unset_index ! heat : heat content of liquid runoff from glc integer :: f_heat_rofi = unset_index ! heat : heat content of ice runoff integer :: f_heat_rofi_glc = unset_index ! heat : heat content of ice runoff from glc + integer :: f_heat_rofa = unset_index ! heat : total heat content of runoff to atm (noresm - v2) + integer :: f_heat_hmat = unset_index ! heat : surface material enthalpy flux (noresm - v2) integer :: f_watr_frz = unset_index ! water: freezing integer :: f_watr_melt = unset_index ! water: melting @@ -305,6 +307,11 @@ subroutine med_diag_init(gcomp, rc) call add_to_budget_diag(budget_diags%fields, f_heat_rofi_glc ,'hrofi_glc') ! field heat : enthalpy of ice runoff from glc f_heat_beg = f_heat_frz ! field first index for heat f_heat_end = f_heat_rofi_glc ! field last index for heat + else if (trim(budget_table_version) == 'v2') then + call add_to_budget_diag(budget_diags%fields, f_heat_rofa ,'hrofa' ) ! field heat : total enthalpy of runoff to atm + call add_to_budget_diag(budget_diags%fields, f_heat_hmat ,'hmat' ) ! field heat : surface material enthalpy flux + f_heat_beg = f_heat_frz ! field first index for heat + f_heat_end = f_heat_hmat ! field last index for heat end if ! ----------------------------------------- @@ -312,21 +319,21 @@ subroutine med_diag_init(gcomp, rc) ! ----------------------------------------- ! Note that this order is important here to determine f_watr_beg and f_watr_end - if (trim(budget_table_version) == 'v0') then + if (trim(budget_table_version) == 'v0' .or. trim(budget_table_version) == 'v2') then !BLOM for v2 call add_to_budget_diag(budget_diags%fields, f_watr_frz ,'wfreeze' ) ! field water: freezing end if call add_to_budget_diag(budget_diags%fields, f_watr_melt ,'wmelt' ) ! field water: melting call add_to_budget_diag(budget_diags%fields, f_watr_rain ,'wrain' ) ! field water: precip, liquid call add_to_budget_diag(budget_diags%fields, f_watr_snow ,'wsnow' ) ! field water: precip, frozen call add_to_budget_diag(budget_diags%fields, f_watr_evap ,'wevap' ) ! field water: evaporation - if (trim(budget_table_version) == 'v0') then + if (trim(budget_table_version) == 'v0' .or. trim(budget_table_version) == 'v2') then !BLOM for v2 call add_to_budget_diag(budget_diags%fields, f_watr_salt ,'weqsaltf' ) ! field water: water equivalent of salt flux endif call add_to_budget_diag(budget_diags%fields, f_watr_roff ,'wrunoff' ) ! field water: runoff/flood call add_to_budget_diag(budget_diags%fields, f_watr_roff_glc ,'wrunoff_glc' ) ! field water: runoff/flood from glc call add_to_budget_diag(budget_diags%fields, f_watr_ioff ,'wfrzrof' ) ! field water: frozen runoff call add_to_budget_diag(budget_diags%fields, f_watr_ioff_glc ,'wfrzrof_glc' ) ! field water: frozen runoff from glc - if (trim(budget_table_version) == 'v0') then + if (trim(budget_table_version) == 'v0' .or. trim(budget_table_version) == 'v2') then !BLOM for v2 f_watr_beg = f_watr_frz ! field firs index for water else f_watr_beg = f_watr_melt ! field firs index for water @@ -449,6 +456,7 @@ subroutine med_diag_zero_mode(mode, rc) call shr_log_error(trim(subname)//' mode '//trim(mode)//& ' not recognized', & line=__LINE__, file=u_FILE_u, rc=rc) + return endif end subroutine med_diag_zero_mode @@ -585,6 +593,7 @@ subroutine med_phases_diag_atm(gcomp, rc) real(r8), pointer :: ofrac(:) real(r8), pointer :: areas(:) real(r8), pointer :: lats(:) + real(r8), pointer :: data(:) character(*), parameter :: subName = '(med_phases_diag_atm) ' !------------------------------------------------------------------------------- @@ -644,7 +653,7 @@ subroutine med_phases_diag_atm(gcomp, rc) call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', f_watr_rain, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Note that passing f_watr_rain twice will just add up contributions from Faxa_snowc and Faxa_snowl + ! Note that passing f_watr_snow twice will just add up contributions from Faxa_snowc and Faxa_snowl call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc', f_watr_snow, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -652,6 +661,15 @@ subroutine med_phases_diag_atm(gcomp, rc) areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(budget_table_version) == 'v2') then + call fldbun_getdata1d(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hmat', data, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + nf = f_heat_hmat + do n = 1,size(data) + budget_local(nf,c_atm_recv,ip) = budget_local(nf,c_atm_recv,ip) - areas(n)*data(n)*ofrac(n) + end do + end if + ! heat implied by snow flux from atm to mediator budget_local(f_heat_latf,c_atm_recv ,ip) = -budget_local(f_watr_snow,c_atm_recv ,ip)*shr_const_latice budget_local(f_heat_latf,c_lnd_arecv,ip) = -budget_local(f_watr_snow,c_lnd_arecv,ip)*shr_const_latice @@ -677,18 +695,24 @@ subroutine med_phases_diag_atm(gcomp, rc) end do call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_lwup', f_heat_lwup, & - areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, component_contribution=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_lat', f_heat_latvap, & - areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, component_contribution=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_sen', f_heat_sen, & - areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, component_contribution=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_evap', f_watr_evap, & - areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, component_contribution=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(budget_table_version) == 'v2') then + call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_hrof', f_heat_rofa, & + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, component_contribution=.false., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + deallocate(afrac) call t_stopf('MED:'//subname) end subroutine med_phases_diag_atm @@ -728,7 +752,8 @@ subroutine diag_atm_recv(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifra end if end subroutine diag_atm_recv - subroutine diag_atm_send(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifrac, budget, rc) + subroutine diag_atm_send(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifrac, budget, & + component_contribution, rc) ! input/output variables type(ESMF_FieldBundle) , intent(in) :: FB character(len=*) , intent(in) :: fldname @@ -740,6 +765,7 @@ subroutine diag_atm_send(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifra real(r8) , intent(in) :: ofrac(:) real(r8) , intent(in) :: ifrac(:) real(r8) , intent(inout) :: budget(:,:,:) + logical , intent(in) :: component_contribution integer , intent(out) :: rc ! local variables integer :: n, ip @@ -752,14 +778,18 @@ subroutine diag_atm_send(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifra ip = period_inst do n = 1,size(data) budget(nf,c_atm_send,ip) = budget(nf,c_atm_send,ip) - areas(n)*data(n)*afrac(n) - budget(nf,c_lnd_asend,ip) = budget(nf,c_lnd_asend,ip) + areas(n)*data(n)*lfrac(n) - budget(nf,c_ocn_asend,ip) = budget(nf,c_ocn_asend,ip) + areas(n)*data(n)*ofrac(n) - if (lats(n) > 0.0_r8) then - budget(nf,c_inh_asend,ip) = budget(nf,c_inh_asend,ip) + areas(n)*data(n)*ifrac(n) - else - budget(nf,c_ish_asend,ip) = budget(nf,c_ish_asend,ip) + areas(n)*data(n)*ifrac(n) - end if end do + if (component_contribution) then + do n = 1,size(data) + budget(nf,c_lnd_asend,ip) = budget(nf,c_lnd_asend,ip) + areas(n)*data(n)*lfrac(n) + budget(nf,c_ocn_asend,ip) = budget(nf,c_ocn_asend,ip) + areas(n)*data(n)*ofrac(n) + if (lats(n) > 0.0_r8) then + budget(nf,c_inh_asend,ip) = budget(nf,c_inh_asend,ip) + areas(n)*data(n)*ifrac(n) + else + budget(nf,c_ish_asend,ip) = budget(nf,c_ish_asend,ip) + areas(n)*data(n)*ifrac(n) + end if + end do + end if end if end subroutine diag_atm_send @@ -939,14 +969,14 @@ subroutine med_phases_diag_rof( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if ( fldbun_fldchk(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofl_glc', rc=rc)) then - call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofl_glc' , f_watr_roff_glc, & - ic, areas, budget_local, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofl_glc' , f_watr_roff_glc, & + ic, areas, budget_local, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if ( fldbun_fldchk(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofi_glc', rc=rc)) then - call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofi_glc' , f_watr_ioff_glc, & - ic, areas, budget_local, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofi_glc' , f_watr_ioff_glc, & + ic, areas, budget_local, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice @@ -1176,7 +1206,7 @@ subroutine med_phases_diag_ocn( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_ocn(is_local%wrap%FBImp(compatm,compocn), 'Faxa_lwdn', f_heat_lwdn, ic, areas, ofrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else ! POP + else ! BLOM call diag_ocn(is_local%wrap%FBMed_aoflux_o, 'Faox_lwup' , f_heat_lwup , ic, areas, ofrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_ocn(is_local%wrap%FBExp(compocn), 'Faxa_lwdn' , f_heat_lwdn , ic, areas, sfrac, budget_local, rc=rc) @@ -1188,7 +1218,7 @@ subroutine med_phases_diag_ocn( gcomp, rc) call diag_ocn(is_local%wrap%FBMed_aoflux_o, 'Faox_evap', f_watr_evap , ic, areas, ofrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (fldbun_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_lat', rc=rc)) then ! POP + if (fldbun_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_lat', rc=rc)) then ! BLOM call diag_ocn(is_local%wrap%FBMed_aoflux_o, 'Faox_lat' , f_heat_latvap , ic, areas, ofrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else ! MOM6 @@ -1247,22 +1277,32 @@ subroutine med_phases_diag_ocn( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrain', f_heat_rain , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', f_heat_snow , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hevap', f_heat_evap , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hcond', f_heat_cond , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', f_heat_rofl , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc', f_heat_rofl_glc , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', f_heat_rofi , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc', f_heat_rofi_glc , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(budget_table_version) == 'v1') then + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrain', f_heat_rain , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', f_heat_snow , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hevap', f_heat_evap , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hcond', f_heat_cond , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', f_heat_rofl , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc', f_heat_rofl_glc , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', f_heat_rofi , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc', f_heat_rofi_glc , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + if (trim(budget_table_version) == 'v2') then + ! f_heat_hmat to ocean is sum of contribution from two terms + call diag_ocn(is_local%wrap%FBExp(compocn), 'Faxa_hmat', f_heat_hmat , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Faxa_hmat_oa', f_heat_hmat , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice @@ -1524,13 +1564,13 @@ subroutine med_phases_diag_ice_med2ice( gcomp, rc) ic = c_inh_send budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice - if (trim(budget_table_version) == 'v0') then + if (trim(budget_table_version) == 'v0' .or. trim(budget_table_version) == 'v2') then !BLOM for v2 budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX end if ic = c_ish_send budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice - if (trim(budget_table_version) == 'v0') then + if (trim(budget_table_version) == 'v0' .or. trim(budget_table_version) == 'v2') then !BLOM for v2 budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX end if @@ -1958,7 +1998,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) integer , intent(in) :: tod ! local variables - integer :: nf ! data array indicies + integer :: nf ! data array index real(r8) :: atm_area, lnd_area, ocn_area real(r8) :: ice_area_nh, ice_area_sh real(r8) :: sum_area diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 30178417f..beb3805e6 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -1051,6 +1051,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ ! For mapconsf_uv3d do not use packed field bundles call med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapconsf_uv3d, map_stress=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + else ! ----------------------------------- @@ -1323,6 +1324,7 @@ subroutine med_map_field_normalized(field_src, field_dst, routehandles, maptype, character(len=*), parameter :: subname=' (med_map_mod:med_map_field_normalized) ' !----------------------------------------------------------- + call t_startf('MED:'//subname) rc = ESMF_SUCCESS call ESMF_FieldGet(field_normsrc, farrayPtr=data_normsrc, rc=rc) @@ -1428,6 +1430,8 @@ subroutine med_map_field_normalized(field_src, field_dst, routehandles, maptype, line=__LINE__, file=u_FILE_u, rc=rc) return end if + + call t_stopf('MED:'//subname) end subroutine med_map_field_normalized !================================================================================ @@ -1572,6 +1576,7 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, map_stress, r character(len=*), parameter :: subname=' (med_map_mod:med_map_uv_cart3d) ' !------------------------------------------------------------------------------- + call t_startf('MED:'//subname) rc = ESMF_SUCCESS lmap_stress = .false. @@ -1697,6 +1702,7 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, map_stress, r deallocate(ownedElemCoords_src) deallocate(ownedElemCoords_dst) + call t_stopf('MED:'//subname) end subroutine med_map_uv_cart3d end module med_map_mod diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 772d5c8b5..35a15ca84 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -13,7 +13,7 @@ module med_phases_history_mod use ESMF , only : ESMF_Alarm, ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_AlarmGet use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO - use ESMF , only : ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT + use ESMF , only : ESMF_SUCCESS use ESMF , only : operator(-), operator(+) use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet @@ -37,10 +37,13 @@ module med_phases_history_mod public :: med_phases_history_write ! inst only - for all variables ! Public routines called from post phases - public :: med_phases_history_write_comp ! inst, avg, aux for component - public :: med_phases_history_write_med ! inst only, med aoflux and ocn albedoes - public :: med_phases_history_write_lnd2glc ! inst only, yearly average of lnd->glc data on lnd grid - + public :: med_phases_history_write_comp ! inst, avg, aux for component + public :: med_phases_history_write_med ! inst only, med aoflux and ocn albedoes + public :: med_phases_history_write_data2glc ! inst only, average (normally yearly) of + ! implnd->glc (on land grid), + ! impocn->glc (on ocn grid) and + ! inst only, average (normally yearly) of + ! export->glc (on glc grid) ! Private routines private :: med_phases_history_write_comp_inst ! write instantaneous file for a given component private :: med_phases_history_write_comp_avg ! write averaged file for a given component @@ -536,20 +539,21 @@ subroutine med_phases_history_write_med(gcomp, rc) end subroutine med_phases_history_write_med !=============================================================================== - subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) + subroutine med_phases_history_write_data2glc(gcomp, fldbun_import, comp_import, fldbun_export, rc) ! Write yearly average of lnd -> glc fields on both land and glc grids - use med_internalstate_mod, only : complnd, compglc - use med_constants_mod , only : SecPerDay => med_constants_SecPerDay - use med_io_mod , only : med_io_write_time, med_io_define_time - use med_io_mod , only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date + use med_internalstate_mod , only : compglc, complnd, compocn + use med_constants_mod , only : SecPerDay => med_constants_SecPerDay + use med_io_mod , only : med_io_write_time, med_io_define_time + use med_io_mod , only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date ! input/output variables - type(ESMF_GridComp) , intent(in) :: gcomp - type(ESMF_FieldBundle) , intent(in) :: fldbun_lnd - integer , intent(out) :: rc - type(ESMF_FieldBundle) , intent(in), optional :: fldbun_glc(:) + type(ESMF_GridComp) , intent(in) :: gcomp + type(ESMF_FieldBundle) , optional , intent(in) :: fldbun_import ! land or ocean import field bundle + integer , optional , intent(in) :: comp_import ! either land or ocean component id + type(ESMF_FieldBundle) , optional , intent(in) :: fldbun_export(:) ! export field bundle array + integer , intent(out) :: rc ! local variables type(file_desc_t) :: io_file @@ -570,11 +574,11 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) character(len=CL) :: hist_file integer :: m,n logical :: isPresent - character(len=*), parameter :: subname='(med_phases_history_write_lnd2glc)' + character(len=*), parameter :: subname='(med_phases_history_write_data2glc)' !--------------------------------------- rc = ESMF_SUCCESS - if (maintask) call ufs_trace_wrapper("cmeps", "med_phases_history_write_lnd2glc", "B") + if (maintask) call ufs_trace_wrapper("cmeps", "med_phases_history_write_data2glc", "B") ! Get the internal state nullify(is_local%wrap) @@ -623,6 +627,19 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.1yr2glc.',trim(nexttime_str),'.nc' + if (present(comp_import)) then + if (.not. present(fldbun_import)) then + call shr_log_error(subname//'if comp_import is present, then fldbun_import must be present', rc=rc) + return + end if + if (comp_import == complnd) then + write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.lnd2glc.',trim(nexttime_str),'.nc' + else if (comp_import == compocn) then + write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.ocn2glc.',trim(nexttime_str),'.nc' + end if + else + write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.exp2glc.',trim(nexttime_str),'.nc' + end if ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) @@ -643,18 +660,23 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call med_io_write(io_file, fldbun_lnd, whead(m), wdata(m), & - is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & - nt=1, pre=trim(compname(complnd))//'Imp', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (present(fldbun_glc)) then - do n = 1,size(fldbun_glc) - call med_io_write(io_file, fldbun_glc(n), whead(m), wdata(m), & + if (present(fldbun_import)) then + ! import field bundle + call med_io_write(io_file, fldbun_import, whead(m), wdata(m), & + is_local%wrap%nx(comp_import), is_local%wrap%ny(comp_import), & + nt=1, pre=trim(compname(comp_import))//'Imp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else if (present(fldbun_export)) then + ! export field bundle + do n = 1,size(fldbun_export) + call med_io_write(io_file, fldbun_export(n), whead(m), wdata(m), & is_local%wrap%nx(compglc(n)), is_local%wrap%ny(compglc(n)), & nt=1, pre=trim(compname(compglc(n)))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do + else + call shr_log_error(subname//'either fldbun_import or fldbun_export must be present as arguments', rc=rc) + return end if end do ! end of loop over m @@ -663,8 +685,8 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (maintask) call ufs_trace_wrapper("cmeps", "med_phases_history_write_lnd2glc", "E") - end subroutine med_phases_history_write_lnd2glc + if (maintask) call ufs_trace_wrapper("cmeps", "med_phases_history_write_data2glc", "E") + end subroutine med_phases_history_write_data2glc !=============================================================================== subroutine med_phases_history_write_comp(gcomp, compid, rc) diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 5f247192d..ff44def36 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -59,12 +59,14 @@ module med_phases_ocnalb_mod character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' ! used, reused in module - logical :: flux_albav ! use average dif and dir albedos - logical :: use_nextswcday ! use the scalar field for next time (otherwise, will be set using clock) - logical :: use_min_albedo ! apply minimum value of albedo for direct vis, nir - real(R8) :: min_albedo ! minimum value of albedo for direct vis, nir - real(R8) :: albdif ! 60 deg reference albedo, diffuse - real(R8) :: albdir ! 60 deg reference albedo, direct + logical :: flux_albav ! use average dif and dir albedos + logical :: use_nextswcday ! use the scalar field for next time (otherwise, will be set using clock) + logical :: use_min_albedo ! apply minimum value of albedo for direct vis, nir + logical :: use_briegleb ! use Briegleb et al. (1986) ocean albedo scheme + real(R8) :: min_albedo ! minimum value of albedo for direct vis, nir + real(R8) :: albdif ! 60 deg reference albedo, diffuse + real(R8) :: albdir ! 60 deg reference albedo, direct + integer :: ocean_albedo_scheme ! 0: Briegleb et al. (1986); 1: Taylor et al. (1996) !=============================================================================== contains !=============================================================================== @@ -77,7 +79,7 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) ! All input field bundles are ASSUMED to be on the ocean grid !----------------------------------------------------------------------- - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_LogWrite, ESMF_LogSetError, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_Mesh, ESMF_MeshGet use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_FieldBundleGet, ESMF_Field, ESMF_FieldGet @@ -105,7 +107,6 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) logical :: use_min_ocnalb logical :: isPresent, isSet integer :: fieldCount - character(CL) :: msg type(ESMF_Field), pointer :: fieldlist(:) character(*), parameter :: subname = '(med_phases_ocnalb_init) ' !----------------------------------------------------------------------- @@ -233,18 +234,36 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) if (.not. isPresent ) then use_nextswcday = .false. endif - - if (flux_albav) then - write(msg,'(2(A,f8.2))') trim(subname)//': mean albedos set: albdif = ',albdif,', albdir = ',albdir - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + ! Determine ocean albedo scheme + call NUOPC_CompAttributeGet(gcomp, name='ocean_albedo_scheme', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) ocean_albedo_scheme else - if (use_min_albedo) then - write(msg,'(A,f8.2)') trim(subname)//': min_albedo setting = ',min_albedo - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + ocean_albedo_scheme = 0 + end if + + if (maintask) then + if (flux_albav) then + write(logunit,'(2(A,f8.2))') trim(subname)//': mean albedos set: albdif = ',albdif,', albdir = ',albdir + else + if (use_min_albedo) then + write(logunit,'(A,f8.2)') trim(subname)//': min_albedo setting = ',min_albedo + end if end if + write(logunit,'(A,l1)') trim(subname)//': use_nextswcday setting is ',use_nextswcday + write(logunit,'(A,i1)') trim(subname)//': ocean_albedo_scheme setting is ',ocean_albedo_scheme + end if + if (ocean_albedo_scheme == 0) then + use_briegleb = .true. + elseif (ocean_albedo_scheme == 1 ) then + use_briegleb = .false. + else + call ESMF_LogSetError(ESMF_FAILURE, & + msg=trim(subname)//": ERROR: unknown ocean_albedo_scheme", & + line=__LINE__, file=__FILE__, rcToReturn=rc) + return end if - write(msg,'(A,l1)') trim(subname)//': use_nextswcday setting is ',use_nextswcday - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -452,9 +471,15 @@ subroutine med_phases_ocnalb_run(gcomp, rc) rlon = const_deg2rad * ocnalb%lons(n) cosz = shr_orb_cosz( nextsw_cday, rlat, rlon, delta ) if (cosz > 0.0_r8) then !--- sun hit -- - ocnalb%anidr(n) = (.026_r8/(cosz**1.7_r8 + 0.065_r8)) + & - (.150_r8*(cosz - 0.100_r8 ) * & - (cosz - 0.500_r8 ) * (cosz - 1.000_r8 ) ) + if (use_briegleb) then + ! Briegleb et al. (1986) scheme + ocnalb%anidr(n) = (.026_r8/(cosz**1.7_r8 + 0.065_r8)) + & + (.150_r8*(cosz - 0.100_r8 ) * & + (cosz - 0.500_r8 ) * (cosz - 1.000_r8 ) ) + else + ! Taylor et al. (1996) scheme + ocnalb%anidr(n) = 0.037_r8/(1.1_r8*cosz**1.4_r8 + 0.15_r8) + endif if (use_min_albedo) then ocnalb%anidr(n) = max (ocnalb%anidr(n), min_albedo) end if diff --git a/mediator/med_phases_post_ocn_mod.F90 b/mediator/med_phases_post_ocn_mod.F90 index 29b191b02..f440653a7 100644 --- a/mediator/med_phases_post_ocn_mod.F90 +++ b/mediator/med_phases_post_ocn_mod.F90 @@ -90,11 +90,17 @@ subroutine med_phases_post_ocn(gcomp, rc) end if ! Accumulate ocn input for glc if there is ocn->glc coupling - if (is_local%wrap%ocn2glc_coupling) then - call ESMF_LogWrite(subname//' DEBUG: calling med_phases_prep_glc_accum_ocn', ESMF_LOGMSG_INFO) - call med_phases_prep_glc_accum_ocn(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + ! Do this ONLY when the driver clock is created, + ! same as in med_prep_phases_post_lnd + ! If driver clock is created + ! then we are in the run phase + ! otherwise are in the initialization phase + if (ESMF_ClockIsCreated(dclock)) then + if (is_local%wrap%ocn2glc_coupling) then + call med_phases_prep_glc_accum_ocn(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + endif ! Write ocn inst, avg or aux if requested in mediator attributes call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index e33144eea..d5c0bce40 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -51,7 +51,7 @@ module med_phases_post_rof_mod character(len=13), parameter :: fields_to_remove_negative_runoff_glc(2) = & ['Forr_rofl_glc', & 'Forr_rofi_glc'] - + character(*) , parameter :: u_FILE_u = & __FILE__ @@ -109,7 +109,10 @@ subroutine med_phases_post_rof_init(gcomp, rc) call t_stopf('MED:'//subname) end subroutine med_phases_post_rof_init + !================================================================================================ subroutine med_phases_post_rof(gcomp, rc) + !--------------------------------------------------------------- + ! Post runoff phase ! input/output variables type(ESMF_GridComp) :: gcomp @@ -220,6 +223,7 @@ subroutine med_phases_post_rof(gcomp, rc) end subroutine med_phases_post_rof + !================================================================================================ subroutine med_phases_post_rof_create_rof_field_bundle(gcomp, rc) !--------------------------------------------------------------- ! Create FBrof_r @@ -290,6 +294,7 @@ subroutine med_phases_post_rof_create_rof_field_bundle(gcomp, rc) end subroutine med_phases_post_rof_create_rof_field_bundle + !================================================================================================ subroutine med_phases_post_rof_remove_negative_runoff(gcomp, field_name, rc) !--------------------------------------------------------------- ! For one runoff field, remove negative runoff by downweighting all positive runoff to diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index b230ade31..eab2a74e3 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -31,8 +31,10 @@ module med_phases_prep_atm_mod public :: med_phases_prep_atm public :: med_phases_prep_atm_enthalpy_correction + public :: med_phases_prep_atm_enthalpy_runoff - real(r8), public :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_ocn + real(r8) :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_ocn + real(r8) :: global_hrof_corr(1) = 0._r8 ! enthalpy of run-off from med_phases_prep_ocn character(len=13) :: fldnames_from_ocn(5) = (/'Faoo_fbrf_ocn','Faoo_fdms_ocn','Faoo_fco2_ocn',& 'Faoo_fn2o_ocn','Faoo_fnh3_ocn'/) @@ -233,14 +235,25 @@ subroutine med_phases_prep_atm(gcomp, rc) end if end do - ! Add enthalpy correction to sensible heat if appropriate - if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then + ! Only do the following correction if the mediator is computing the enthalpy to be sent to the ocean + ! from rain, snow, etc. + if ( FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_sen' , rc=rc) .and. & + .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hmat', rc=rc)) then call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Faxx_sen', dataptr1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,size(dataptr1) dataptr1(n) = dataptr1(n) + global_htot_corr(1) end do end if + ! Only do the following if the atmosphere is computing the enthalpy to be sent to the ocean + ! from rain, snow, etc. + if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_hrof', rc=rc)) then + call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Faxx_hrof', dataptr1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(dataptr1) + dataptr1(n) = global_hrof_corr(1) + end do + end if ! Check for nans in fields export to atm call FB_check_for_nans(is_local%wrap%FBExp(compatm), maintask, logunit, rc=rc) @@ -269,6 +282,8 @@ subroutine med_phases_prep_atm_enthalpy_correction (gcomp, hcorr, rc) ! 'Foxx_evap','Foxx_hevap','Foxx_hcond','Foxx_rofl', ! 'Foxx_hrofl','Foxx_rofi','Foxx_hrofi','Foxx_rofl_glc', ! 'Foxx_hrofl_glc','Foxx_rofi_glc','Foxx_hrofi_glc' + ! The result is added as a correction to the sensible heat flux sent back to the atm + ! in subroutine med_phases_prep_atm use ESMF , only : ESMF_VMAllreduce, ESMF_GridCompGet, ESMF_REDUCE_SUM use ESMF , only : ESMF_VM @@ -304,4 +319,47 @@ subroutine med_phases_prep_atm_enthalpy_correction (gcomp, hcorr, rc) end subroutine med_phases_prep_atm_enthalpy_correction + !----------------------------------------------------------------------------- + subroutine med_phases_prep_atm_enthalpy_runoff(gcomp, hcorr, rc) + + use ESMF , only : ESMF_VMAllreduce, ESMF_GridCompGet, ESMF_REDUCE_SUM + use ESMF , only : ESMF_VM + + ! Enthalpy of runoff calculated called by med_phases_prep_ocn_accum in + ! med_phases_prep_ocn_mod + ! Note that this is only called if the following fields are in FBExp(compocn) + ! - Faxa_hmat, Faxa_hlat + ! The result (Faxx_hrof) is sent back to the atm in subroutine med_phases_prep_atm + + ! input/output variables + type(ESMF_GridComp) , intent(in) :: gcomp + real(r8) , intent(in) :: hcorr(:) + integer , intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: n + real(r8) :: local_hrof_corr(1) + type(ESMF_VM) :: vm + !--------------------------------------- + + rc = ESMF_SUCCESS + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine sum of enthalpy correction for each hcorr index locally + local_hrof_corr(1) = 0._r8 + do n = 1,size(hcorr) + local_hrof_corr(1) = local_hrof_corr(1) + hcorr(n) + end do + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllreduce(vm, senddata=local_hrof_corr, recvdata=global_hrof_corr, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine med_phases_prep_atm_enthalpy_runoff + end module med_phases_prep_atm_mod diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 0d28197be..efe79909e 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -515,7 +515,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) ! Prepare the GLC export Fields from the mediator !--------------------------------------- - use med_phases_history_mod, only : med_phases_history_write_lnd2glc + use med_phases_history_mod, only : med_phases_history_write_data2glc ! input/output variables type(ESMF_GridComp) :: gcomp @@ -637,8 +637,21 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) call ESMF_LogWrite(trim(subname)//": glc_avg alarm is not ringing - returning", ESMF_LOGMSG_INFO) end if + ! ------------------------------------------------- ! Average and map data from land (and possibly ocean) - if (do_avg) then + ! ------------------------------------------------- + write_histaux_l2x1yrg = .false. + if (lndAccum2glc_cnt > 0) then + call NUOPC_CompAttributeGet(gcomp, name="histaux_l2x1yrg", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) write_histaux_l2x1yrg + end if + end if + + do_avg_check: if (do_avg) then + if (ESMF_FieldBundleIsCreated(FBlndAccum2glc_l)) then ! Average import from accumulated land import data as long as the accumulator has ! been created (if accum_lnd2glc is false, the accumulator isn't created, but this @@ -655,6 +668,9 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) end if end if + ! ------------------------------------------------- + ! ocean to glc coupling + ! ------------------------------------------------- if (is_local%wrap%ocn2glc_coupling) then ! Average import from accumulated ocn import data do n = 1, size(fldnames_fr_ocn) @@ -695,23 +711,22 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) where (data2d == 0._r8) data2d = shr_const_spval end do end do + + ! Write import auxiliary file for ocn if appropriate + if (write_histaux_l2x1yrg) then + call med_phases_history_write_data2glc(gcomp, fldbun_import=FBocnAccum2glc_o, comp_import=compocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Reset ocean accumulator ocnAccum2glc_cnt = 0 call fldbun_reset(FBocnAccum2glc_o, value=czero, rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return end if - ! Determine if auxiliary file will be written - write_histaux_l2x1yrg = .false. - if (lndAccum2glc_cnt > 0) then - call NUOPC_CompAttributeGet(gcomp, name="histaux_l2x1yrg", value=cvalue, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) write_histaux_l2x1yrg - end if - end if - - ! Write auxiliary history file if flag is set and accumulation is being done + ! ------------------------------------------------- + ! lnd to glc coupling + ! ------------------------------------------------- if (is_local%wrap%lnd2glc_coupling) then ! Map accumulated field bundle from land grid (with elevation classes) to glc grid (without elevation classes) ! and set FBExp(compglc(ns)) data @@ -719,38 +734,46 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) call med_phases_prep_glc_map_lnd2glc(gcomp, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return + ! Write lnd2glc export data if (write_histaux_l2x1yrg) then - call med_phases_history_write_lnd2glc(gcomp, FBlndAccum2glc_l, & - fldbun_glc=is_local%wrap%FBExp(compglc(:)), rc=rc) + call med_phases_history_write_data2glc(gcomp, fldbun_export=is_local%wrap%FBExp(compglc(:)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - lndAccum2glc_cnt = 0 - call fldbun_reset(FBlndAccum2glc_l, value=czero, rc=rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return - else - if (write_histaux_l2x1yrg) then - call med_phases_history_write_lnd2glc(gcomp, FBlndAccum2glc_l, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + if (dbug_flag > 1) then + do ns = 1,is_local%wrap%num_icesheets + call fldbun_diagnose(is_local%wrap%FBExp(compglc(ns)), string=trim(subname)//' FBexp(compglc) ', rc=rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + end do + endif end if - if (dbug_flag > 1) then - do ns = 1,is_local%wrap%num_icesheets - call fldbun_diagnose(is_local%wrap%FBExp(compglc(ns)), string=trim(subname)//' FBexp(compglc) ', rc=rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return - end do - endif - end if + ! Write lnd2glc import data + if (write_histaux_l2x1yrg) then + call med_phases_history_write_data2glc(gcomp, fldbun_import=FBlndAccum2glc_l, comp_import=complnd, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + lndAccum2glc_cnt = 0 + call fldbun_reset(FBlndAccum2glc_l, value=czero, rc=rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + + end if do_avg_check + + ! ------------------------------------------------- ! Check for nans in fields export to glc - do ns = 1,is_local%wrap%num_icesheets - call FB_check_for_nans(is_local%wrap%FBExp(compglc(ns)), maintask, logunit, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do + ! ------------------------------------------------- + if (is_local%wrap%lnd2glc_coupling) then + do ns = 1,is_local%wrap%num_icesheets + call FB_check_for_nans(is_local%wrap%FBExp(compglc(ns)), maintask, logunit, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + end if + ! ------------------------------------------------- ! Check water tracers (if there are no water tracers or these checks aren't enabled, ! this will return without doing anything) + ! ------------------------------------------------- do ns = 1,is_local%wrap%num_icesheets call med_methods_FB_check_wtracers(is_local%wrap%FBExp(compglc(ns)), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 79771e074..5864488ca 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -4,6 +4,7 @@ module med_phases_prep_ocn_mod ! Mediator phases for preparing ocn export from mediator !----------------------------------------------------------------------------- + use shr_log_mod , only : shr_log_error use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_constants_mod , only : czero =>med_constants_czero use med_constants_mod , only : dbug_flag => med_constants_dbug_flag @@ -36,6 +37,8 @@ module med_phases_prep_ocn_mod private :: med_phases_prep_ocn_custom + character(len=CS) :: component_computes_enthalpy_flux + character(*), parameter :: u_FILE_u = & __FILE__ @@ -45,6 +48,7 @@ module med_phases_prep_ocn_mod subroutine med_phases_prep_ocn_init(gcomp, rc) + use NUOPC , only : NUOPC_CompAttributeGet use ESMF , only : ESMF_GridComp, ESMF_SUCCESS use med_methods_mod , only : FB_Init => med_methods_FB_init @@ -55,6 +59,8 @@ subroutine med_phases_prep_ocn_init(gcomp, rc) ! local variables type(InternalState) :: is_local type(med_field_info_type), allocatable :: field_info_array(:) + character(len=CL) :: cvalue + logical :: isPresent, IsSet character(len=*),parameter :: subname=' (med_phases_prep_ocn_init) ' !--------------------------------------- @@ -80,6 +86,15 @@ subroutine med_phases_prep_ocn_init(gcomp, rc) call FB_reset(is_local%wrap%FBExpAccumOcn, value=czero, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name="component_computes_enthalpy_flux", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + component_computes_enthalpy_flux = trim(cvalue) + else + component_computes_enthalpy_flux = 'none' + end if + end subroutine med_phases_prep_ocn_init !----------------------------------------------------------------------------- @@ -89,7 +104,9 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use med_constants_mod , only : shr_const_cpsw, shr_const_tkfrz, shr_const_pi use med_constants_mod , only : shr_const_cpice + use med_constants_mod , only : shr_const_cpfw use med_phases_prep_atm_mod , only : med_phases_prep_atm_enthalpy_correction + use med_phases_prep_atm_mod , only : med_phases_prep_atm_enthalpy_runoff ! input/output variables type(ESMF_GridComp) :: gcomp @@ -112,6 +129,20 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) real(r8), allocatable :: hcorr(:) type(med_fldlist_type), pointer :: fldList character(len=*), parameter :: subname='(med_phases_prep_ocn_accum)' + ! + ! The following applies only to coupling_mode of noresm + real(r8), pointer :: dataptr(:) + real(r8), pointer :: Faxa_hmat (:) + real(r8), pointer :: Faxa_hlat (:) + real(r8), allocatable :: hrof2atm(:) + real(r8) :: ocean_htot_corr(1) + real(r8) :: ocean_atot_corr(1) + real(r8), allocatable :: hrof(:) + ! if separate_varlat is true then do global ocean average for + ! hmat_oa only for the net-mass part, and pass in hmat only local + ! variable latent heat correction part + logical, parameter :: separate_varlat=.true. + real(r8), allocatable :: acorr(:) !--------------------------------------- if (maintask) call ufs_trace_wrapper("cmeps", "med_phases_prep_ocn_accum", "B") @@ -166,100 +197,213 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- - !--- custom calculations + !--- custom calculation - enthalpy flux computed in mediator for cesm !--------------------------------------- - ! compute enthalpy associated with rain, snow, condensation and liquid river & glc runoff - ! the sea-ice model already accounts for the enthalpy flux (as part of melth), so - ! enthalpy from meltw **is not** included below - if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrain' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_snow' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hsnow' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hevap' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hcond' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc' , rc=rc)) then - - call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rain, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrain', hrain, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_evap' , evap, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hevap', hevap, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hcond', hcond, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(coupling_mode) == 'cesm') then + ! compute enthalpy associated with rain, snow, condensation and liquid river & glc runoff + ! the sea-ice model already accounts for the enthalpy flux (as part of melth), so + ! enthalpy from meltw **is not** included below + if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrain' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_snow' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hsnow' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hevap' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hcond' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc' , rc=rc) & + ) then + ! Error check + if (trim(component_computes_enthalpy_flux) /= 'med') then + call shr_log_error(trim(subname)//' ERROR: component_computes_enthalpy_flux must be set to med', rc=rc) + return + end if + call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rain, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrain', hrain, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_evap' , evap, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hevap', hevap, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hcond', hcond, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_snow' , snow, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', hsnow, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rofl, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', hrofl, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rofi, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', hrofi, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , rofl_glc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc', hrofl_glc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rofi_glc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc', hrofi_glc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(tocn) + ! Need max to ensure that will not have an enthalpy contribution if the water is below 0C + hrain(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rain(n) * shr_const_cpsw + hsnow(n) = min((tocn(n) - shr_const_tkfrz), 0._r8) * snow(n) * shr_const_cpsw + hevap(n) = (tocn(n) - shr_const_tkfrz) * min(evap(n), 0._r8) * shr_const_cpsw + hcond(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * max(evap(n), 0._r8) * shr_const_cpsw + hrofl(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rofl(n) * shr_const_cpsw + hrofl_glc(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rofl_glc(n) * shr_const_cpsw + ! −10 C is a reasonable bulk temperature assumption for iceberg/land-ice runoff + hrofi(n) = -10._r8 * rofi(n) * shr_const_cpice + hrofi_glc(n) = -10._r8 * rofi_glc(n) * shr_const_cpice + end do + if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then + ! Determine enthalpy correction factor that will be added to the sensible heat flux sent to the atm + ! Areas here in radians**2 - this is an instantaneous snapshot that will be sent to the atm - only + ! need to calculate this if data is sent back to the atm + allocate(hcorr(size(tocn))) + glob_area_inv = 1._r8 / (4._r8 * shr_const_pi) + areas => is_local%wrap%mesh_info(compocn)%areas + do n = 1,size(tocn) + hcorr(n) = (hrain(n) + hsnow(n) + hcond(n) + hevap(n) + hrofl(n) + hrofi(n) + hrofl_glc(n) + hrofi_glc(n)) * & + areas(n) * glob_area_inv + end do + call med_phases_prep_atm_enthalpy_correction(gcomp, hcorr, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(hcorr) + end if + end if ! condition for using global energy fixer + end if ! if coupling_mode is cesm - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_snow' , snow, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', hsnow, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !--------------------------------------- + !--- custom calculation - enthalpy flux obtained from prognostic atm for noresm + !--------------------------------------- + if (trim(coupling_mode) == 'noresm') then + if( FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hmat', rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hlat', rc=rc)) then + if (trim(component_computes_enthalpy_flux) /= 'atm') then + call shr_log_error(trim(subname)//' ERROR: component_computes_enthalpy_flux must be set to atm', rc=rc) + return + end if + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_hmat', Faxa_hmat, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_hlat', Faxa_hlat, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rofl, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', hrofl, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + areas => is_local%wrap%mesh_info(compocn)%areas - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rofi, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', hrofi, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! if separate_varlat is true then do global ocean average only for the + ! net-mass part, and pass in as hmat only the local variable latent heat correction part + if (separate_varlat) then + !----------------------- + ! Determine enthalpy due to ocean river input + !----------------------- + allocate(hrof (size(tocn))) + if ( FB_fldchk(is_local%wrap%FBExp(compocn),'Foxx_rofl' ,rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn),'Foxx_rofi' ,rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn),'Forr_rofl_glc',rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn),'Forr_rofi_glc',rc=rc) ) then + + call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Foxx_rofl' , rofl ,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Foxx_rofi' , rofi ,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Forr_rofl_glc', rofl_glc,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Forr_rofi_glc', rofi_glc,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(tocn) + hrof(n) = shr_const_cpfw * (tocn(n) - shr_const_tkfrz) * rofl(n) & + + shr_const_cpice * (tocn(n) - shr_const_tkfrz) * rofi(n) & + + shr_const_cpfw * (tocn(n) - shr_const_tkfrz) * rofl_glc(n) & + + shr_const_cpice * (tocn(n) - shr_const_tkfrz) * rofi_glc(n) + enddo + else + do n = 1,size(tocn) + hrof(n) = 0._r8 + enddo + endif + + ! send back to atm if requested by atm + if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_hrof', rc=rc)) then + allocate(hrof2atm(size(tocn))) + hrof2atm(:) = hrof(:)*areas(:) / (4._r8 * shr_const_pi) + + ! determine module variable global_hrof_corr in med_phases_prep_atm_mod + call med_phases_prep_atm_enthalpy_runoff(gcomp, hrof2atm, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , rofl_glc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc', hrofl_glc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !----------------------- + ! Compute Faxa_hmat_oa + !----------------------- + ! Determine hcorr and acorr + allocate(hcorr(size(tocn))) + allocate(acorr(size(tocn))) + if (separate_varlat) then + do n = 1,size(tocn) + hcorr(n) = areas(n) *(Faxa_hmat(n) - Faxa_hlat(n) + hrof(n)) + acorr(n) = areas(n) + end do + else + do n = 1,size(tocn) + hcorr(n) = areas(n) * Faxa_hmat(n) + acorr(n) = areas(n) + end do + endif + deallocate(hrof) - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rofi_glc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc', hrofi_glc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Compute global integral of hcorr - ocean_oa_htot + call med_oa_integral(gcomp, hcorr, ocean_htot_corr, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(hcorr) - do n = 1,size(tocn) - ! Need max to ensure that will not have an enthalpy contribution if the water is below 0C - hrain(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rain(n) * shr_const_cpsw - hsnow(n) = min((tocn(n) - shr_const_tkfrz), 0._r8) * snow(n) * shr_const_cpsw - hevap(n) = (tocn(n) - shr_const_tkfrz) * min(evap(n), 0._r8) * shr_const_cpsw - hcond(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * max(evap(n), 0._r8) * shr_const_cpsw - hrofl(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rofl(n) * shr_const_cpsw - hrofl_glc(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rofl_glc(n) * shr_const_cpsw - ! −10 C is a reasonable bulk temperature assumption for iceberg/land-ice runoff - hrofi(n) = -10._r8 * rofi(n) * shr_const_cpice - hrofi_glc(n) = -10._r8 * rofi_glc(n) * shr_const_cpice - end do + ! Compute global integral of acorr - ocean_atot_corr + call med_oa_integral(gcomp, acorr, ocean_atot_corr, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(acorr) - ! Determine enthalpy correction factor that will be added to the sensible heat flux sent to the atm - ! Areas here in radians**2 - this is an instantaneous snapshot that will be sent to the atm - only - ! need to calculate this if data is sent back to the atm + ! Set value of Faxa_hmat_oa to ratio of ocean_htot_corr and ocean_atot_corr + call FB_getfldptr(is_local%wrap%FBExp(compocn), 'Faxa_hmat_oa', dataptr, rc=rc) + if (ocean_atot_corr(1) > 0._r8) then + dataptr(:) = ocean_htot_corr(1)/ocean_atot_corr(1) + end if - if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then - allocate(hcorr(size(tocn))) - glob_area_inv = 1._r8 / (4._r8 * shr_const_pi) - areas => is_local%wrap%mesh_info(compocn)%areas - do n = 1,size(tocn) - hcorr(n) = (hrain(n) + hsnow(n) + hcond(n) + hevap(n) + hrofl(n) + hrofi(n) + hrofl_glc(n) + hrofi_glc(n)) * & - areas(n) * glob_area_inv - end do - call med_phases_prep_atm_enthalpy_correction(gcomp, hcorr, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - deallocate(hcorr) - end if + !----------------------- + ! replace full material enthalpy flux with variable latent + ! heats part only in pointer to ocean export + !----------------------- - end if + ! might add another coupling field later but may not be strictly necessary + if (separate_varlat) then + do n = 1,size(tocn) + Faxa_hmat(n) = Faxa_hlat(n) + end do + else + do n = 1,size(tocn) + Faxa_hmat(n) = 0._r8 ! avoid applying twice for some ocean components such as BLOM + end do + endif + endif + end if ! end of coupling_mode is noresm - ! custom merges to ocean + !--------------------------------------- + !--- custom merges to ocean + !--------------------------------------- call med_phases_prep_ocn_custom(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -679,4 +823,40 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc) end subroutine med_phases_prep_ocn_custom + !----------------------------------------------------------------------------- + subroutine med_oa_integral (gcomp, local_array, global_integral, rc) + + use ESMF , only : ESMF_VMAllreduce, ESMF_GridComp, ESMF_GridCompGet, ESMF_REDUCE_SUM, ESMF_SUCCESS + use ESMF , only : ESMF_VM + + ! input/output variables + type(ESMF_GridComp) , intent(in) :: gcomp + real(r8) , intent(in) :: local_array(:) + real(r8) , intent(out) :: global_integral(1) + integer , intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: n + real(r8) :: local_sum(1) + type(ESMF_VM) :: vm + !--------------------------------------- + + rc = ESMF_SUCCESS + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + ! sum contributions to integral + local_sum(1) = 0._r8 + do n = 1,size(local_array) + local_sum(1) = local_sum(1) + local_array(n) + end do + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllreduce(vm, senddata=local_sum, recvdata=global_integral, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine med_oa_integral + end module med_phases_prep_ocn_mod diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 45261a885..dc5507733 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -23,6 +23,7 @@ module med_phases_prep_rof_mod use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_accum => med_methods_FB_accum use med_methods_mod , only : fldbun_average => med_methods_FB_average + use med_methods_mod , only : fldbun_fldChk => med_methods_FB_FldChk use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_methods_mod , only : med_methods_FB_check_wtracers @@ -128,13 +129,16 @@ subroutine med_phases_prep_rof_init(gcomp, rc) do while(associated(fldptr)) call med_fld_GetFldInfo(fldptr, stdname=fldname) if (trim(fldname) .ne. trim(is_local%wrap%flds_scalar_name)) then - n = n+1 - fldnames_temp(n) = fldname - endif + if (fldbun_fldchk(is_local%wrap%FBImp(complnd,complnd), trim(fldname), rc=rc) .and. & + fldbun_fldchk(is_local%wrap%FBExp(comprof) , trim(fldname), rc=rc) ) then + n = n+1 + fldnames_temp(n) = fldname + endif + end if fldptr => fldptr%next enddo allocate(lnd2rof_flds(n)) - lnd2rof_flds = fldnames_temp(1:n) + lnd2rof_flds(1:n) = fldnames_temp(1:n) deallocate(fldnames_temp) ! Get lnd and rof meshes @@ -208,7 +212,7 @@ subroutine med_phases_prep_rof_init(gcomp, rc) lndAccum2rof_cnt = 0 fldList => med_fldList_GetFldListFr(complnd) - ! Create packed mapping from rof->lnd + ! Create packed mapping from lnd to rof call med_map_packed_field_create(destcomp=comprof, & flds_scalar_name=is_local%wrap%flds_scalar_name, & @@ -356,13 +360,14 @@ subroutine med_phases_prep_rof(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if - ! Reset the irrig_flux_field with the map_lnd2rof_irrig calculation below if appropriate - if ( NUOPC_IsConnected(is_local%wrap%NStateImp(complnd), fieldname=trim(irrig_flux_field))) then + if ( NUOPC_IsConnected(is_local%wrap%NStateImp(complnd), fieldname=trim(irrig_flux_field)) .and. & + is_local%wrap%med_coupling_active(comprof,complnd)) then call med_phases_prep_rof_irrig( gcomp, rc=rc ) if (chkerr(rc,__LINE__,u_FILE_u)) return else ! This will ensure that no irrig is sent from the land call fldbun_getdata1d(FBlndAccum2rof_r, irrig_flux_field, dataptr_out, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return dataptr_out(:) = czero end if diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 4161816f8..46160b47e 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -453,13 +453,13 @@ subroutine med_phases_restart_write(gcomp, rc) nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) call med_io_write(io_file, FBocnAccum2glc_o, whead(m), wdata(m), nx, ny, & - nt=1, pre='ocnImpAccum2glc_o', rc=rc) + nt=1, pre='ocnImpAccum2glc', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_write(io_file, ocnAccum2glc_cnt, 'ocnImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! Write ocn albedo field bundle (CESM only) + ! Write ocn albedo field bundle (CESM/NorESM only) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn)