diff --git a/config/e3sm/config_grids.xml b/config/e3sm/config_grids.xml index 49b3615d54b..4e2a875ac81 100644 --- a/config/e3sm/config_grids.xml +++ b/config/e3sm/config_grids.xml @@ -1232,6 +1232,16 @@ oQU120 + + T62 + T62 + oEC60to30v3wLI + rx1 + mpas.ais20km + null + oEC60to30v3wLI + + ww3a @@ -2955,12 +2965,25 @@ + cpl/gridmaps/mpas.ais20km/map_ais20km_to_oQU120_aave.160331.nc + cpl/gridmaps/mpas.ais20km/map_ais20km_to_oQU120_nearestdtos.160331.nc cpl/gridmaps/mpas.ais20km/map_ais20km_to_oQU120_aave.160331.nc - cpl/gridmaps/oQU120/map_oQU120_to_ais20km_aave.160331.nc cpl/gridmaps/mpas.ais20km/map_ais20km_to_oQU120_nearestdtos.160331.nc cpl/gridmaps/mpas.ais20km/map_ais20km_to_oQU120_nearestdtos.160331.nc cpl/gridmaps/mpas.ais20km/map_ais20km_to_oQU120_nearestdtos.160331.nc - cpl/gridmaps/oQU120/map_oQU120_to_ais20km_nearestdtos.160331.nc + cpl/gridmaps/oQU120/map_oQU120_to_ais20km_aave.160331.nc + cpl/gridmaps/oQU120/map_oQU120_to_ais20km_neareststod.160331.nc + + + + cpl/gridmaps/mpas.ais20km/map_ais20km_to_oEC60to30v3wLI_nomask_aave.190207.nc + cpl/gridmaps/mpas.ais20km/map_ais20km_to_oEC60to30v3wLI_nomask_nearestdtos.190207.nc + cpl/gridmaps/mpas.ais20km/map_ais20km_to_oEC60to30v3wLI_nomask_aave.190207.nc + cpl/gridmaps/mpas.ais20km/map_ais20km_to_oEC60to30v3wLI_nomask_nearestdtos.190207.nc + cpl/gridmaps/mpas.ais20km/map_ais20km_to_oEC60to30v3wLI_nomask_nearestdtos.190207.nc + cpl/gridmaps/mpas.ais20km/map_ais20km_to_oEC60to30v3wLI_nomask_nearestdtos.190207.nc + cpl/gridmaps/oEC60to30v3wLI/map_oEC60to30v3wLI_nomask_to_ais20km_aave.190207.nc + cpl/gridmaps/oEC60to30v3wLI/map_oEC60to30v3wLI_nomask_to_ais20km_neareststod.190207.nc diff --git a/config/e3sm/machines/config_machines.xml b/config/e3sm/machines/config_machines.xml index ba9f6f95cbb..75bec0802f9 100644 --- a/config/e3sm/machines/config_machines.xml +++ b/config/e3sm/machines/config_machines.xml @@ -699,7 +699,7 @@ sems-git acme-binutils sems-python/2.7.9 - sems-cmake/2.8.12 + sems-cmake/3.10.3 sems-gcc/7.3.0 diff --git a/scripts/lib/CIME/build.py b/scripts/lib/CIME/build.py index 40073e8d248..f7aa74db8c1 100644 --- a/scripts/lib/CIME/build.py +++ b/scripts/lib/CIME/build.py @@ -33,6 +33,12 @@ def xml_to_make_variable(case, varname): return "{}=\"{}\" ".format(varname, varvalue) +############################################################################### +def uses_kokkos(case): +############################################################################### + cam_target = case.get_value("CAM_TARGET") + return cam_target in ("preqx_kokkos", "theta-l") + ############################################################################### def _build_model(build_threaded, exeroot, incroot, complist, lid, caseroot, cimeroot, compiler, buildlist, comp_interface): @@ -228,12 +234,11 @@ def _build_libraries(case, exeroot, sharedpath, caseroot, cimeroot, libroot, lid os.makedirs(shared_item) mpilib = case.get_value("MPILIB") - cam_target = case.get_value("CAM_TARGET") libs = ["gptl", "mct", "pio", "csm_share"] if mpilib == "mpi-serial": libs.insert(0, mpilib) - if cam_target == "preqx_kokkos": + if uses_kokkos(case): libs.append("kokkos") logs = [] @@ -444,8 +449,6 @@ def _case_build_impl(caseroot, case, sharedlib_only, model_only, buildlist, if get_model() == "e3sm" and mach == "titan" and compiler == "pgiacc": case.set_value("CAM_TARGET", "preqx_acc") - cam_target = case.get_value("CAM_TARGET") - # This is a timestamp for the build , not the same as the testid, # and this case may not be a test anyway. For a production # experiment there may be many builds of the same case. @@ -495,8 +498,7 @@ def _case_build_impl(caseroot, case, sharedlib_only, model_only, buildlist, if not sharedlib_only: os.environ["INSTALL_SHAREDPATH"] = os.path.join(exeroot, sharedpath) # for MPAS makefile generators - # Set USE_KOKKOS to true if cam is preqx_kokkos - if cam_target == "preqx_kokkos": + if uses_kokkos(case): os.environ["USE_KOKKOS"] = "TRUE" logs.extend(_build_model(build_threaded, exeroot, incroot, complist, diff --git a/scripts/lib/CIME/case/check_lockedfiles.py b/scripts/lib/CIME/case/check_lockedfiles.py index 6f29f664461..c2f3760a377 100644 --- a/scripts/lib/CIME/case/check_lockedfiles.py +++ b/scripts/lib/CIME/case/check_lockedfiles.py @@ -9,8 +9,9 @@ from CIME.XML.env_case import EnvCase from CIME.XML.env_mach_pes import EnvMachPes from CIME.XML.env_batch import EnvBatch -from CIME.utils import run_cmd_no_fail from CIME.locked_files import unlock_file, LOCKED_DIR +from CIME.build import clean + logger = logging.getLogger(__name__) import glob, six @@ -39,7 +40,7 @@ def check_pelayouts_require_rebuild(self, models): if old_tasks != new_tasks or old_threads != new_threads or old_inst != new_inst: logging.warning("{} pe change requires clean build {} {}".format(comp, old_tasks, new_tasks)) cleanflag = comp.lower() - run_cmd_no_fail("./case.build --clean {}".format(cleanflag)) + clean(self, cleanlist=[cleanflag]) unlock_file("env_mach_pes.xml", self.get_value("CASEROOT")) diff --git a/scripts/lib/CIME/hist_utils.py b/scripts/lib/CIME/hist_utils.py index 235555d4ccc..ddbc0b17385 100644 --- a/scripts/lib/CIME/hist_utils.py +++ b/scripts/lib/CIME/hist_utils.py @@ -3,7 +3,7 @@ """ from CIME.XML.standard_module_setup import * from CIME.test_status import TEST_NO_BASELINES_COMMENT, TEST_STATUS_FILENAME -from CIME.utils import get_current_commit, get_timestamp, get_model, safe_copy, SharedArea +from CIME.utils import get_current_commit, get_timestamp, get_model, safe_copy, SharedArea, parse_test_name import logging, os, re, filecmp logger = logging.getLogger(__name__) @@ -572,7 +572,10 @@ def _generate_baseline_impl(case, baseline_dir=None, allow_baseline_overwrite=Fa safe_copy(newestcpllogfile, os.path.join(basegen_dir, "{}.log.gz".format(cplname)), preserve_meta=False) testname = case.get_value("TESTCASE") - expect(num_gen > 0 or testname == "PFS", "Could not generate any hist files for case '{}', something is seriously wrong".format(os.path.join(rundir, testcase))) + testopts = parse_test_name(case.get_value("CASEBASEID"))[1] + testopts = [] if testopts is None else testopts + expect(num_gen > 0 or (testname == "PFS" or "B" in testopts), + "Could not generate any hist files for case '{}', something is seriously wrong".format(os.path.join(rundir, testcase))) if get_model() == "e3sm": bless_log = os.path.join(basegen_dir, BLESS_LOG_NAME) diff --git a/src/drivers/mct/cime_config/config_component.xml b/src/drivers/mct/cime_config/config_component.xml index d3fb65a3e2e..73cdb63e2b7 100644 --- a/src/drivers/mct/cime_config/config_component.xml +++ b/src/drivers/mct/cime_config/config_component.xml @@ -1626,6 +1626,42 @@ glc2lnd state mapping file decomp type + + char + idmap_ignore + run_domain + env_run.xml + glc2ice flux mapping file - the default value idmap_ignore, if set, will be ignored by buildnml and + will generate a runtime error if in fact a file is required for the given compset + + + + char + X,Y + X + run_domain + env_run.xml + glc2ice flux mapping file decomp type + + + + char + idmap_ignore + run_domain + env_run.xml + glc2ice state mapping file - the default value idmap_ignore, if set, will be ignored by buildnml and + will generate a runtime error if in fact a file is required for the given compset + + + + char + X,Y + X + run_domain + env_run.xml + glc2ice state mapping file decomp type + + char idmap_ignore @@ -1644,6 +1680,42 @@ glc2ice runoff mapping file decomp type + + char + idmap_ignore + run_domain + env_run.xml + glc2ocn flux mapping file - the default value idmap_ignore, if set, will be ignored by buildnml and + will generate a runtime error if in fact a file is required for the given compset + + + + char + X,Y + Y + run_domain + env_run.xml + glc2ocn flux mapping file decomp type + + + + char + idmap_ignore + run_domain + env_run.xml + glc2ocn state mapping file - the default value idmap_ignore, if set, will be ignored by buildnml and + will generate a runtime error if in fact a file is required for the given compset + + + + char + X,Y + Y + run_domain + env_run.xml + glc2ocn state mapping file decomp type + + char idmap_ignore @@ -1680,6 +1752,42 @@ glc2ocn runoff mapping file decomp type for ice runoff + + char + idmap_ignore + run_domain + env_run.xml + ocn2glc flux mapping file - the default value idmap_ignore, if set, will be ignored by buildnml and + will generate a runtime error if in fact a file is required for the given compset + + + + char + X,Y + Y + run_domain + env_run.xml + ocn2glc flux mapping file decomp type + + + + char + idmap_ignore + run_domain + env_run.xml + ocn2glc state mapping file - the default value idmap_ignore, if set, will be ignored by buildnml and + will generate a runtime error if in fact a file is required for the given compset + + + + char + X,Y + Y + run_domain + env_run.xml + ocn2glc state mapping file decomp type + + char idmap diff --git a/src/drivers/mct/cime_config/config_component_e3sm.xml b/src/drivers/mct/cime_config/config_component_e3sm.xml index 7da2b682fc0..63fe71989c3 100644 --- a/src/drivers/mct/cime_config/config_component_e3sm.xml +++ b/src/drivers/mct/cime_config/config_component_e3sm.xml @@ -88,7 +88,11 @@ 12 run_flags env_run.xml - timer detail FIXME - add documentation + Sets maximum number of run loop timing data checkpoints. + This sets values for tprof_option and tprof_n that determine + the timing output file frequency. If less than one, uses + defaults for tprof_option and tprof_n and also allows them + to be set in user_nl_cpl. @@ -352,7 +356,7 @@ 1 1 1 - 24 + $ATM_NCPL 48 $ATM_NCPL 12 @@ -372,7 +376,7 @@ 1 1 1 - 24 + $ATM_NCPL $ATM_NCPL run_coupling @@ -722,74 +726,6 @@ compsets. - - char - idmap - run_domain - env_run.xml - ocn2glc flux mapping file - - - - char - X,Y - Y - run_domain - env_run.xml - ocn2glc flux mapping file decomp type - - - - char - idmap - run_domain - env_run.xml - ocn2glc state mapping file - - - - char - X,Y - Y - run_domain - env_run.xml - ocn2glc state mapping file decomp type - - - - char - idmap - run_domain - env_run.xml - glc2ocn flux mapping file - - - - char - X,Y - Y - run_domain - env_run.xml - glc2ocn flux mapping file decomp type - - - - char - idmap - run_domain - env_run.xml - glc2ocn state mapping file - - - - char - X,Y - Y - run_domain - env_run.xml - glc2ocn state mapping file decomp type - - integer diff --git a/src/drivers/mct/cime_config/namelist_definition_drv.xml b/src/drivers/mct/cime_config/namelist_definition_drv.xml index f63c78459ee..77708c0f44c 100644 --- a/src/drivers/mct/cime_config/namelist_definition_drv.xml +++ b/src/drivers/mct/cime_config/namelist_definition_drv.xml @@ -3895,6 +3895,66 @@ + + char + mapping + abs + seq_maps + + glc to ocn flux mapping file for fluxes + + + $GLC2OCN_FMAPNAME + + + + + char + mapping + seq_maps + + The type of mapping desired, either "source" or "destination" mapping. + X is associated with rearrangement of the source grid to the + destination grid and then local mapping. Y is associated with mapping + on the source grid and then rearrangement and sum to the destination + grid. + + + $GLC2OCN_FMAPTYPE + X + + + + + char + mapping + abs + seq_maps + + glc to ocn state mapping file for states + + + $GLC2OCN_SMAPNAME + + + + + char + mapping + seq_maps + + The type of mapping desired, either "source" or "destination" mapping. + X is associated with rearrangement of the source grid to the + destination grid and then local mapping. Y is associated with mapping + on the source grid and then rearrangement and sum to the destination + grid. + + + $GLC2OCN_SMAPTYPE + X + + + char mapping @@ -3955,6 +4015,66 @@ + + char + mapping + abs + seq_maps + + ocn to glc flux mapping file for fluxes + + + $OCN2GLC_FMAPNAME + + + + + char + mapping + seq_maps + + The type of mapping desired, either "source" or "destination" mapping. + X is associated with rearrangement of the source grid to the + destination grid and then local mapping. Y is associated with mapping + on the source grid and then rearrangement and sum to the destination + grid. + + + $OCN2GLC_FMAPTYPE + X + + + + + char + mapping + abs + seq_maps + + ocn to glc state mapping file for states + + + $OCN2GLC_SMAPNAME + + + + + char + mapping + seq_maps + + The type of mapping desired, either "source" or "destination" mapping. + X is associated with rearrangement of the source grid to the + destination grid and then local mapping. Y is associated with mapping + on the source grid and then rearrangement and sum to the destination + grid. + + + $OCN2GLC_SMAPTYPE + X + + + char mapping @@ -4166,6 +4286,66 @@ + + char + mapping + abs + seq_maps + + glc to ice flux mapping file for fluxes + + + $GLC2ICE_FMAPNAME + + + + + char + mapping + seq_maps + + The type of mapping desired, either "source" or "destination" mapping. + X is associated with rearrangement of the source grid to the + destination grid and then local mapping. Y is associated with mapping + on the source grid and then rearrangement and sum to the destination + grid. + + + $GLC2ICE_FMAPTYPE + X + + + + + char + mapping + abs + seq_maps + + glc to ice state mapping file for states + + + $GLC2ICE_SMAPNAME + + + + + char + mapping + seq_maps + + The type of mapping desired, either "source" or "destination" mapping. + X is associated with rearrangement of the source grid to the + destination grid and then local mapping. Y is associated with mapping + on the source grid and then rearrangement and sum to the destination + grid. + + + $GLC2ICE_SMAPTYPE + X + + + char mapping diff --git a/src/drivers/mct/main/cime_comp_mod.F90 b/src/drivers/mct/main/cime_comp_mod.F90 index a0831467fe3..a140c85b14a 100644 --- a/src/drivers/mct/main/cime_comp_mod.F90 +++ b/src/drivers/mct/main/cime_comp_mod.F90 @@ -228,6 +228,7 @@ module cime_comp_mod private :: cime_run_calc_budgets3 private :: cime_run_write_history private :: cime_run_write_restart + private :: cime_write_performance_checkpoint #include @@ -414,6 +415,7 @@ module cime_comp_mod logical :: lnd_c2_glc ! .true. => lnd to glc coupling on logical :: ocn_c2_atm ! .true. => ocn to atm coupling on logical :: ocn_c2_ice ! .true. => ocn to ice coupling on + logical :: ocn_c2_glcshelf ! .true. => ocn to glc ice shelf coupling on logical :: ocn_c2_wav ! .true. => ocn to wav coupling on logical :: ice_c2_atm ! .true. => ice to atm coupling on logical :: ice_c2_ocn ! .true. => ice to ocn coupling on @@ -424,6 +426,8 @@ module cime_comp_mod logical :: glc_c2_lnd ! .true. => glc to lnd coupling on logical :: glc_c2_ocn ! .true. => glc to ocn coupling on logical :: glc_c2_ice ! .true. => glc to ice coupling on + logical :: glcshelf_c2_ocn ! .true. => glc ice shelf to ocn coupling on + logical :: glcshelf_c2_ice ! .true. => glc ice shelf to ice coupling on logical :: wav_c2_ocn ! .true. => wav to ocn coupling on logical :: iac_c2_lnd ! .true. => iac to lnd coupling on @@ -1084,7 +1088,7 @@ subroutine cime_pre_init2() reprosum_use_ddpdd=reprosum_use_ddpdd , & reprosum_allow_infnan=reprosum_allow_infnan, & reprosum_diffmax=reprosum_diffmax , & - reprosum_recompute=reprosum_recompute, & + reprosum_recompute=reprosum_recompute , & max_cplstep_time=max_cplstep_time) ! above - cpl_decomp is set to pass the cpl_decomp value to seq_mctext_decomp @@ -1460,6 +1464,7 @@ subroutine cime_init() call t_stopf('CPL:comp_list_all') call t_stopf('CPL:init_comps') + !---------------------------------------------------------- !| Determine coupling interactions based on present and prognostic flags !---------------------------------------------------------- @@ -1499,6 +1504,7 @@ subroutine cime_init() iceberg_prognostic=iceberg_prognostic, & ocn_prognostic=ocn_prognostic, & ocnrof_prognostic=ocnrof_prognostic, & + ocn_c2_glcshelf=ocn_c2_glcshelf, & glc_prognostic=glc_prognostic, & rof_prognostic=rof_prognostic, & wav_prognostic=wav_prognostic, & @@ -1566,6 +1572,8 @@ subroutine cime_init() glc_c2_lnd = .false. glc_c2_ocn = .false. glc_c2_ice = .false. + glcshelf_c2_ocn = .false. + glcshelf_c2_ice = .false. wav_c2_ocn = .false. iac_c2_atm = .false. iac_c2_lnd = .false. @@ -1589,6 +1597,7 @@ subroutine cime_init() if (atm_present ) ocn_c2_atm = .true. ! needed for aoflux calc if aoflux=atm if (ice_prognostic) ocn_c2_ice = .true. if (wav_prognostic) ocn_c2_wav = .true. + endif if (ice_present) then if (atm_prognostic) ice_c2_atm = .true. @@ -1603,7 +1612,10 @@ subroutine cime_init() if (glc_present) then if (glclnd_present .and. lnd_prognostic) glc_c2_lnd = .true. if (glcocn_present .and. ocn_prognostic) glc_c2_ocn = .true. + ! For now, glcshelf->ocn only activated if the ocean has activated ocn->glcshelf + if (ocn_c2_glcshelf .and. glcocn_present .and. ocn_prognostic) glcshelf_c2_ocn = .true. if (glcice_present .and. iceberg_prognostic) glc_c2_ice = .true. + if (glcocn_present .and. ice_prognostic) glcshelf_c2_ice = .true. endif if (wav_present) then if (ocn_prognostic) wav_c2_ocn = .true. @@ -1681,6 +1693,7 @@ subroutine cime_init() write(logunit,F0L)'lnd_c2_glc = ',lnd_c2_glc write(logunit,F0L)'ocn_c2_atm = ',ocn_c2_atm write(logunit,F0L)'ocn_c2_ice = ',ocn_c2_ice + write(logunit,F0L)'ocn_c2_glcshelf = ',ocn_c2_glcshelf write(logunit,F0L)'ocn_c2_wav = ',ocn_c2_wav write(logunit,F0L)'ice_c2_atm = ',ice_c2_atm write(logunit,F0L)'ice_c2_ocn = ',ice_c2_ocn @@ -1691,6 +1704,8 @@ subroutine cime_init() write(logunit,F0L)'glc_c2_lnd = ',glc_c2_lnd write(logunit,F0L)'glc_c2_ocn = ',glc_c2_ocn write(logunit,F0L)'glc_c2_ice = ',glc_c2_ice + write(logunit,F0L)'glcshelf_c2_ocn = ',glcshelf_c2_ocn + write(logunit,F0L)'glcshelf_c2_ice = ',glcshelf_c2_ice write(logunit,F0L)'wav_c2_ocn = ',wav_c2_ocn write(logunit,F0L)'iac_c2_lnd = ',iac_c2_lnd write(logunit,F0L)'iac_c2_atm = ',iac_c2_atm @@ -1760,6 +1775,11 @@ subroutine cime_init() if ((glclnd_present .or. glcocn_present .or. glcice_present) .and. .not.glc_present) then call shr_sys_abort(subname//' ERROR: if glcxxx present must also have glc present') endif + if ((ocn_c2_glcshelf .and. .not. glcshelf_c2_ocn) .or. (glcshelf_c2_ocn .and. .not. ocn_c2_glcshelf)) then + ! Current logic will not allow this to be true, but future changes could make it so, which may be nonsensical + call shr_sys_abort(subname//' ERROR: if glc_c2_ocn must also have ocn_c2_glc and vice versa. '//& + 'Boundary layer fluxes calculated in coupler require input from both components.') + endif if (rofice_present .and. .not.rof_present) then call shr_sys_abort(subname//' ERROR: if rofice present must also have rof present') endif @@ -1814,13 +1834,13 @@ subroutine cime_init() call prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_lnd) - call prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_ocn, wav_c2_ocn, glc_c2_ocn) + call prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_ocn, wav_c2_ocn, glc_c2_ocn, glcshelf_c2_ocn) - call prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, rof_c2_ice ) + call prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, glcshelf_c2_ice, rof_c2_ice ) call prep_rof_init(infodata, lnd_c2_rof) - call prep_glc_init(infodata, lnd_c2_glc) + call prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glcshelf) call prep_wav_init(infodata, atm_c2_wav, ocn_c2_wav, ice_c2_wav) @@ -2219,12 +2239,22 @@ subroutine cime_init() if (glc_c2_ocn) then call prep_ocn_calc_g2x_ox(timer='CPL:init_glc2ocn') endif + + if (glcshelf_c2_ocn) then + call prep_ocn_shelf_calc_g2x_ox(timer='CPL:init_glc2ocn_shelf') + endif + if (rof_c2_ice) then call prep_ice_calc_r2x_ix(timer='CPL:init_rof2ice') endif if (glc_c2_ice) then call prep_ice_calc_g2x_ix(timer='CPL:init_glc2ice') endif + + if (glcshelf_c2_ice) then + call prep_ice_shelf_calc_g2x_ix(timer='CPL:init_glc2ice_shelf') + endif + if (rof_c2_lnd) then call prep_lnd_calc_r2x_lx(timer='CPL:init_rof2lnd') endif @@ -2326,6 +2356,15 @@ subroutine cime_run() force_stop_ymd = -1 force_stop_tod = -1 + ! --- Write out performance data for initialization + call seq_timemgr_EClockGetData( EClock_d, curr_ymd=ymd, curr_tod=tod) + write(timing_file,'(a,i8.8,a1,i5.5)') & + trim(tchkpt_dir)//"/model_timing"//trim(cpl_inst_tag)//"_",ymd,"_",tod + + call t_set_prefixf("CPL:INIT_") + call cime_write_performance_checkpoint(output_perf,timing_file,mpicom_GLOID) + call t_unset_prefixf() + !|---------------------------------------------------------- !| Beginning of driver time step loop !|---------------------------------------------------------- @@ -3215,30 +3254,14 @@ subroutine cime_run() if ((tod == 0) .and. in_first_day) then in_first_day = .false. endif - call t_adj_detailf(+1) - - call t_startf("CPL:sync1_tprof") - call mpi_barrier(mpicom_GLOID,ierr) - call t_stopf("CPL:sync1_tprof") write(timing_file,'(a,i8.8,a1,i5.5)') & - trim(tchkpt_dir)//"/model_timing"//trim(cpl_inst_tag)//"_",ymd,"_",tod + trim(tchkpt_dir)//"/model_timing"//trim(cpl_inst_tag)//"_",ymd,"_",tod - call t_set_prefixf("CPL:") - if (output_perf) then - call t_prf(filename=trim(timing_file), mpicom=mpicom_GLOID, & - num_outpe=0, output_thispe=output_perf) - else - call t_prf(filename=trim(timing_file), mpicom=mpicom_GLOID, & - num_outpe=0) - endif + call t_set_prefixf("CPL:RUN_LOOP_") + call cime_write_performance_checkpoint(output_perf,timing_file,mpicom_GLOID) call t_unset_prefixf() - call t_startf("CPL:sync2_tprof") - call mpi_barrier(mpicom_GLOID,ierr) - call t_stopf("CPL:sync2_tprof") - - call t_adj_detailf(-1) endif call t_stopf ('CPL:TPROF_WRITE') @@ -3335,9 +3358,11 @@ subroutine cime_final() call t_adj_detailf(-1) call t_stopf ('CPL:FINAL') - call t_startf("sync3_tprof") + call t_set_prefixf("CPL:FINAL_") + + call t_startf("sync1_tprf") call mpi_barrier(mpicom_GLOID,ierr) - call t_stopf("sync3_tprof") + call t_stopf("sync1_tprf") if (output_perf) then call t_prf(trim(timing_dir)//'/model_timing'//trim(cpl_inst_tag), & @@ -3347,6 +3372,8 @@ subroutine cime_final() mpicom=mpicom_GLOID) endif + call t_unset_prefixf() + call t_finalizef() end subroutine cime_final @@ -3718,6 +3745,8 @@ subroutine cime_run_ocn_recv_post() call component_diag(infodata, ocn, flow='c2x', comment= 'recv ocn', & info_debug=info_debug, timer_diag='CPL:ocnpost_diagav') + call cime_run_ocnglc_coupling() + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) call t_drvstopf ('CPL:OCNPOSTT',cplrun=.true.) endif @@ -3867,6 +3896,50 @@ subroutine cime_run_atmocn_setup(hashint) end subroutine cime_run_atmocn_setup +!---------------------------------------------------------------------------------- + + subroutine cime_run_ocnglc_coupling() + !--------------------------------------- + ! Description: Run calculation of coupling fluxes between OCN and GLC + ! Note: this happens in the coupler to allow it be calculated on the + ! ocean time step but the GLC grid. + !--------------------------------------- + + if (glc_present) then + + if (ocn_c2_glcshelf .and. glcshelf_c2_ocn) then + ! the boundary flux calculations done in the coupler require inputs from both GLC and OCN, + ! so they will only be valid if both OCN->GLC and GLC->OCN + + call prep_glc_calc_o2x_gx(timer='CPL:glcprep_ocn2glc') !remap ocean fields to o2x_g at ocean couping interval + + call prep_glc_calculate_subshelf_boundary_fluxes ! this is actual boundary layer flux calculation + !this outputs + !x2g_g/g2x_g, where latter is going + !to ocean, so should get remapped to + !ocean grid in prep_ocn_shelf_calc_g2x_ox + call prep_ocn_shelf_calc_g2x_ox(timer='CPL:glcpost_glcshelf2ocn') + !Map g2x_gx shelf fields that were updated above, to g2x_ox. + !Do this at intrinsic coupling + !frequency + call prep_ice_shelf_calc_g2x_ix(timer='CPL:glcpost_glcshelf2ice') + !Map g2x_gx shelf fields to g2x_ix. + !Do this at intrinsic coupling + !frequency. This is perhaps an + !unnecessary place to put this + !call, since these fields aren't + !changing on the intrinsic + !timestep. But I don't think it's + !unsafe to do it here. + + call prep_glc_accum_ocn(timer='CPL:glcprep_accum_ocn') !accum x2g_g fields here into x2g_gacc + + endif + + endif + + end subroutine cime_run_ocnglc_coupling + !---------------------------------------------------------------------------------- subroutine cime_run_lnd_setup_send() @@ -3940,7 +4013,7 @@ subroutine cime_run_lnd_recv_post() ! Accumulate rof and glc inputs (module variables in prep_rof_mod and prep_glc_mod) if (lnd_c2_rof) call prep_rof_accum(timer='CPL:lndpost_accl2r') - if (lnd_c2_glc) call prep_glc_accum(timer='CPL:lndpost_accl2g') + if (lnd_c2_glc) call prep_glc_accum_lnd(timer='CPL:lndpost_accl2g' ) if (lnd_c2_iac) call prep_iac_accum(timer='CPL:lndpost_accl2z') if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) @@ -3963,24 +4036,26 @@ subroutine cime_run_glc_setup_send(lnd2glc_averaged_now) call t_drvstartf ('CPL:GLCPREP',cplrun=.true.,barrier=mpicom_CPLID) if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - if (lnd_c2_glc) then - ! NOTE - only create appropriate input to glc if the avg_alarm is on + ! NOTE - only create appropriate input to glc if the avg_alarm is on + if (lnd_c2_glc .or. ocn_c2_glcshelf) then if (glcrun_avg_alarm) then call prep_glc_accum_avg(timer='CPL:glcprep_avg') - lnd2glc_averaged_now = .true. - ! Note that l2x_gx is obtained from mapping the module variable l2gacc_lx - call prep_glc_calc_l2x_gx(fractions_lx, timer='CPL:glcprep_lnd2glc') + if (lnd_c2_glc) then + lnd2glc_averaged_now = .true. + ! Note that l2x_gx is obtained from mapping the module variable l2gacc_lx + call prep_glc_calc_l2x_gx(fractions_lx, timer='CPL:glcprep_lnd2glc') - call prep_glc_mrg(infodata, fractions_gx, timer_mrg='CPL:glcprep_mrgx2g') + call prep_glc_mrg_lnd(infodata, fractions_gx, timer_mrg='CPL:glcprep_mrgx2g') + endif call component_diag(infodata, glc, flow='x2c', comment='send glc', & info_debug=info_debug, timer_diag='CPL:glcprep_diagav') else call prep_glc_zero_fields() - end if ! glcrun_avg_alarm - end if ! lnd_c2_glc + endif ! glcrun_avg_alarm + end if ! lnd_c2_glc or ocn_c2_glcshelf if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) call t_drvstopf ('CPL:GLCPREP',cplrun=.true.) @@ -4467,4 +4542,42 @@ subroutine cime_run_write_restart(drv_pause, write_restart, drv_resume) end subroutine cime_run_write_restart +!---------------------------------------------------------------------------------- + + subroutine cime_write_performance_checkpoint(output_ckpt, ckpt_filename, & + ckpt_mpicom) + + !---------------------------------------------------------- + ! Checkpoint performance data + !---------------------------------------------------------- + + logical, intent(in) :: output_ckpt + character(len=*), intent(in) :: ckpt_filename + integer, intent(in) :: ckpt_mpicom + +103 format( 5A ) +104 format( A, i10.8, i8) + + call t_adj_detailf(+1) + + call t_startf("sync1_tprf") + call mpi_barrier(ckpt_mpicom,ierr) + call t_stopf("sync1_tprf") + + if (output_ckpt) then + call t_prf(filename=trim(ckpt_filename), mpicom=ckpt_mpicom, & + num_outpe=0, output_thispe=output_ckpt) + else + call t_prf(filename=trim(ckpt_filename), mpicom=ckpt_mpicom, & + num_outpe=0) + endif + + call t_startf("sync2_tprf") + call mpi_barrier(ckpt_mpicom,ierr) + call t_stopf("sync2_tprf") + + call t_adj_detailf(-1) + + end subroutine cime_write_performance_checkpoint + end module cime_comp_mod diff --git a/src/drivers/mct/main/prep_glc_mod.F90 b/src/drivers/mct/main/prep_glc_mod.F90 index 48679ad3192..93e5368340d 100644 --- a/src/drivers/mct/main/prep_glc_mod.F90 +++ b/src/drivers/mct/main/prep_glc_mod.F90 @@ -4,7 +4,8 @@ module prep_glc_mod use shr_kind_mod , only: r8 => SHR_KIND_R8 use shr_kind_mod , only: cl => SHR_KIND_CL use shr_sys_mod , only: shr_sys_abort, shr_sys_flush - use seq_comm_mct , only: num_inst_glc, num_inst_lnd, num_inst_frc + use seq_comm_mct , only: num_inst_glc, num_inst_lnd, num_inst_frc, & + num_inst_ocn use seq_comm_mct , only: CPLID, GLCID, logunit use seq_comm_mct , only: seq_comm_getData=>seq_comm_setptrs use seq_infodata_mod, only: seq_infodata_type, seq_infodata_getdata @@ -16,7 +17,7 @@ module prep_glc_mod use perf_mod use component_type_mod, only: component_get_x2c_cx, component_get_c2x_cx use component_type_mod, only: component_get_dom_cx - use component_type_mod, only: glc, lnd + use component_type_mod, only: glc, lnd, ocn use glc_elevclass_mod, only : glc_get_num_elevation_classes, glc_elevclass_as_string use glc_elevclass_mod, only : glc_all_elevclass_strings, GLC_ELEVCLASS_STRLEN @@ -29,12 +30,14 @@ module prep_glc_mod !-------------------------------------------------------------------------- public :: prep_glc_init - public :: prep_glc_mrg + public :: prep_glc_mrg_lnd - public :: prep_glc_accum + public :: prep_glc_accum_lnd + public :: prep_glc_accum_ocn public :: prep_glc_accum_avg public :: prep_glc_calc_l2x_gx + public :: prep_glc_calc_o2x_gx public :: prep_glc_zero_fields @@ -42,16 +45,26 @@ module prep_glc_mod public :: prep_glc_get_l2gacc_lx public :: prep_glc_get_l2gacc_lx_one_instance public :: prep_glc_get_l2gacc_lx_cnt + + public :: prep_glc_get_o2x_gx + public :: prep_glc_get_x2gacc_gx + public :: prep_glc_get_x2gacc_gx_cnt + public :: prep_glc_get_mapper_Sl2g public :: prep_glc_get_mapper_Fl2g + public :: prep_glc_get_mapper_So2g + public :: prep_glc_get_mapper_Fo2g + + public :: prep_glc_calculate_subshelf_boundary_fluxes + !-------------------------------------------------------------------------- ! Private interfaces !-------------------------------------------------------------------------- private :: prep_glc_do_renormalize_smb private :: prep_glc_set_g2x_lx_fields - private :: prep_glc_merge + private :: prep_glc_merge_lnd_forcing private :: prep_glc_map_one_state_field_lnd2glc private :: prep_glc_map_qice_conservative_lnd2glc private :: prep_glc_renormalize_smb @@ -63,12 +76,19 @@ module prep_glc_mod ! mappers type(seq_map), pointer :: mapper_Sl2g type(seq_map), pointer :: mapper_Fl2g + type(seq_map), pointer :: mapper_So2g + type(seq_map), pointer :: mapper_Fo2g type(seq_map), pointer :: mapper_Fg2l ! attribute vectors type(mct_aVect), pointer :: l2x_gx(:) ! Lnd export, glc grid, cpl pes - allocated in driver + type(mct_aVect), pointer :: o2x_gx(:) ! Ocn export, glc grid, cpl pes - allocated in driver ! accumulation variables + + type(mct_aVect), pointer :: x2gacc_gx(:) ! Glc export, glc grid, cpl pes - allocated in driver + integer , target :: x2gacc_gx_cnt ! x2gacc_gx: number of time samples accumulated + type(mct_aVect), pointer :: l2gacc_lx(:) ! Lnd export, lnd grid, cpl pes - allocated in driver integer , target :: l2gacc_lx_cnt ! l2gacc_lx: number of time samples accumulated @@ -79,6 +99,7 @@ module prep_glc_mod ! Should be set to true for 2-way coupled runs with evolving ice sheets. ! Does not need to be true for 1-way coupling. logical :: smb_renormalize + logical :: glc_present ! .true. => glc is present ! Name of flux field giving surface mass balance character(len=*), parameter :: qice_fieldname = 'Flgl_qice' @@ -91,6 +112,22 @@ module prep_glc_mod ! Fields needed in the g2x_lx attribute vector used as part of mapping qice from lnd to glc character(len=:), allocatable :: g2x_lx_fields + type(mct_aVect), pointer :: o2gacc_ox(:) ! Ocn export, lnd grid, cpl pes - allocated in driver + integer , target :: o2gacc_ox_cnt ! number of time samples accumulated + + real(r8), allocatable :: oceanTemperature(:) + real(r8), allocatable :: oceanSalinity(:) + real(r8), allocatable :: oceanHeatTransferVelocity(:) + real(r8), allocatable :: oceanSaltTransferVelocity(:) + real(r8), allocatable :: interfacePressure(:) + real(r8), allocatable :: iceTemperature(:) + real(r8), allocatable :: iceTemperatureDistance(:) + integer, allocatable :: iceFloatingMask(:) + real(r8), allocatable :: outInterfaceSalinity(:) + real(r8), allocatable :: outInterfaceTemperature(:) + real(r8), allocatable :: outFreshwaterFlux(:) + real(r8), allocatable :: outOceanHeatFlux(:) + real(r8), allocatable :: outIceHeatFlux(:) !================================================================================================ @@ -98,7 +135,7 @@ module prep_glc_mod !================================================================================================ - subroutine prep_glc_init(infodata, lnd_c2_glc) + subroutine prep_glc_init(infodata, lnd_c2_glc, ocn_c2_glcshelf) !--------------------------------------------------------------- ! Description @@ -107,19 +144,25 @@ subroutine prep_glc_init(infodata, lnd_c2_glc) ! Arguments type (seq_infodata_type) , intent(inout) :: infodata logical , intent(in) :: lnd_c2_glc ! .true. => lnd to glc coupling on + logical , intent(in) :: ocn_c2_glcshelf ! .true. => ocn to glc coupling on ! ! Local Variables - integer :: eli + integer :: eli, egi, eoi integer :: lsize_l integer :: lsize_g + integer :: lsize_o logical :: samegrid_lg ! samegrid land and glc + logical :: samegrid_go ! .true. => samegrid ocean and glc logical :: esmf_map_flag ! .true. => use esmf for mapping logical :: iamroot_CPLID ! .true. => CPLID masterproc - logical :: glc_present ! .true. => glc is present character(CL) :: lnd_gnam ! lnd grid character(CL) :: glc_gnam ! glc grid + character(CL) :: ocn_gnam ! ocn grid + type(mct_avect), pointer :: l2x_lx type(mct_avect), pointer :: x2g_gx + type(mct_avect), pointer :: o2x_ox + character(*), parameter :: subname = '(prep_glc_init)' character(*), parameter :: F00 = "('"//subname//" : ', 4A )" !--------------------------------------------------------------- @@ -128,10 +171,13 @@ subroutine prep_glc_init(infodata, lnd_c2_glc) esmf_map_flag=esmf_map_flag , & glc_present=glc_present , & lnd_gnam=lnd_gnam , & - glc_gnam=glc_gnam) + glc_gnam=glc_gnam , & + ocn_gnam=ocn_gnam) allocate(mapper_Sl2g) allocate(mapper_Fl2g) + allocate(mapper_So2g) + allocate(mapper_Fo2g) allocate(mapper_Fg2l) smb_renormalize = prep_glc_do_renormalize_smb(infodata) @@ -196,6 +242,69 @@ subroutine prep_glc_init(infodata, lnd_c2_glc) end if + if (glc_present .and. ocn_c2_glcshelf) then + + call seq_comm_getData(CPLID, & + mpicom=mpicom_CPLID, iamroot=iamroot_CPLID) + + o2x_ox => component_get_c2x_cx(ocn(1)) + lsize_o = mct_aVect_lsize(o2x_ox) + + x2g_gx => component_get_x2c_cx(glc(1)) + lsize_g = mct_aVect_lsize(x2g_gx) + + allocate(o2x_gx(num_inst_ocn)) + do eoi = 1,num_inst_ocn + call mct_aVect_init(o2x_gx(eoi), rList=seq_flds_o2x_fields, lsize=lsize_g) + call mct_aVect_zero(o2x_gx(eoi)) + enddo + + allocate(x2gacc_gx(num_inst_glc)) + do egi = 1,num_inst_glc + call mct_aVect_init(x2gacc_gx(egi), x2g_gx, lsize_g) + call mct_aVect_zero(x2gacc_gx(egi)) + end do + + x2gacc_gx_cnt = 0 + samegrid_go = .true. + if (trim(ocn_gnam) /= trim(glc_gnam)) samegrid_go = .false. + if (iamroot_CPLID) then + write(logunit,*) ' ' + write(logunit,F00) 'Initializing mapper_So2g' + end if + call seq_map_init_rcfile(mapper_So2g, ocn(1), glc(1), & + 'seq_maps.rc','ocn2glc_smapname:','ocn2glc_smaptype:',samegrid_go, & + 'mapper_So2g initialization',esmf_map_flag) + if (iamroot_CPLID) then + write(logunit,*) ' ' + write(logunit,F00) 'Initializing mapper_Fo2g' + end if + call seq_map_init_rcfile(mapper_Fo2g, ocn(1), glc(1), & + 'seq_maps.rc','ocn2glc_fmapname:','ocn2glc_fmaptype:',samegrid_go, & + 'mapper_Fo2g initialization',esmf_map_flag) + + !Initialize module-level arrays associated with compute_melt_fluxes + allocate(oceanTemperature(lsize_g)) + allocate(oceanSalinity(lsize_g)) + allocate(oceanHeatTransferVelocity(lsize_g)) + allocate(oceanSaltTransferVelocity(lsize_g)) + allocate(interfacePressure(lsize_g)) + allocate(iceTemperature(lsize_g)) + allocate(iceTemperatureDistance(lsize_g)) + allocate(iceFloatingMask(lsize_g)) + allocate(outInterfaceSalinity(lsize_g)) + allocate(outInterfaceTemperature(lsize_g)) + allocate(outFreshwaterFlux(lsize_g)) + allocate(outOceanHeatFlux(lsize_g)) + allocate(outIceHeatFlux(lsize_g)) + ! TODO: Can we allocate these only while used or are we worried about performance hit? + ! TODO: add deallocates! + + call shr_sys_flush(logunit) + + end if + + end subroutine prep_glc_init !================================================================================================ @@ -290,11 +399,11 @@ end subroutine prep_glc_set_g2x_lx_fields !================================================================================================ - subroutine prep_glc_accum(timer) + subroutine prep_glc_accum_lnd(timer) !--------------------------------------------------------------- ! Description - ! Accumulate glc inputs + ! Accumulate glc inputs from lnd ! ! Arguments character(len=*), intent(in) :: timer @@ -302,7 +411,8 @@ subroutine prep_glc_accum(timer) ! Local Variables integer :: eli type(mct_avect), pointer :: l2x_lx - character(*), parameter :: subname = '(prep_glc_accum)' + + character(*), parameter :: subname = '(prep_glc_accum_lnd)' !--------------------------------------------------------------- call t_drvstartf (trim(timer),barrier=mpicom_CPLID) @@ -317,24 +427,64 @@ subroutine prep_glc_accum(timer) l2gacc_lx_cnt = l2gacc_lx_cnt + 1 call t_drvstopf (trim(timer)) - end subroutine prep_glc_accum + end subroutine prep_glc_accum_lnd + + !================================================================================================ + + subroutine prep_glc_accum_ocn(timer) + + !--------------------------------------------------------------- + ! Description + ! Accumulate glc inputs from ocn + ! + ! Arguments + character(len=*), intent(in) :: timer + ! + ! Local Variables + integer :: egi + type(mct_avect), pointer :: x2g_gx + + character(*), parameter :: subname = '(prep_glc_accum_ocn)' + !--------------------------------------------------------------- + + call t_drvstartf (trim(timer),barrier=mpicom_CPLID) + do egi = 1,num_inst_glc + x2g_gx => component_get_x2c_cx(glc(egi)) + if (x2gacc_gx_cnt == 0) then + call mct_avect_copy(x2g_gx, x2gacc_gx(egi)) + else + call mct_avect_accum(x2g_gx, x2gacc_gx(egi)) + endif + end do + x2gacc_gx_cnt = x2gacc_gx_cnt + 1 + call t_drvstopf (trim(timer)) + + end subroutine prep_glc_accum_ocn !================================================================================================ + subroutine prep_glc_accum_avg(timer) !--------------------------------------------------------------- ! Description ! Finalize accumulation of glc inputs + ! Note: There could be separate accum_avg routines for forcing coming + ! from each component (LND and OCN), but they can be combined here + ! by taking advantage of l2gacc_lx_cnt and x2gacc_gx_cnt variables + ! that will only be greater than 0 if corresponding coupling is enabled. ! ! Arguments character(len=*), intent(in) :: timer ! ! Local Variables - integer :: eli + integer :: eli, egi + type(mct_avect), pointer :: x2g_gx + character(*), parameter :: subname = '(prep_glc_accum_avg)' !--------------------------------------------------------------- + ! Accumulation for LND call t_drvstartf (trim(timer),barrier=mpicom_CPLID) if (l2gacc_lx_cnt > 1) then do eli = 1,num_inst_lnd @@ -342,13 +492,27 @@ subroutine prep_glc_accum_avg(timer) end do end if l2gacc_lx_cnt = 0 + + ! Accumulation for OCN + if (x2gacc_gx_cnt > 1) then + do egi = 1,num_inst_glc + ! temporary formation of average + call mct_avect_avg(x2gacc_gx(egi), x2gacc_gx_cnt) + + ! ***NOTE***THE FOLLOWING ACTUALLY MODIFIES x2g_gx + x2g_gx => component_get_x2c_cx(glc(egi)) + call mct_avect_copy(x2gacc_gx(egi), x2g_gx) + enddo + end if + x2gacc_gx_cnt = 0 + call t_drvstopf (trim(timer)) end subroutine prep_glc_accum_avg !================================================================================================ - subroutine prep_glc_mrg(infodata, fractions_gx, timer_mrg) + subroutine prep_glc_mrg_lnd(infodata, fractions_gx, timer_mrg) !--------------------------------------------------------------- ! Description @@ -362,7 +526,7 @@ subroutine prep_glc_mrg(infodata, fractions_gx, timer_mrg) ! Local Variables integer :: egi, eli, efi type(mct_avect), pointer :: x2g_gx - character(*), parameter :: subname = '(prep_glc_mrg)' + character(*), parameter :: subname = '(prep_glc_mrg_lnd)' !--------------------------------------------------------------- call t_drvstartf (trim(timer_mrg),barrier=mpicom_CPLID) @@ -372,15 +536,15 @@ subroutine prep_glc_mrg(infodata, fractions_gx, timer_mrg) efi = mod((egi-1),num_inst_frc) + 1 x2g_gx => component_get_x2c_cx(glc(egi)) - call prep_glc_merge(l2x_gx(eli), fractions_gx(efi), x2g_gx) + call prep_glc_merge_lnd_forcing(l2x_gx(eli), fractions_gx(efi), x2g_gx) enddo call t_drvstopf (trim(timer_mrg)) - end subroutine prep_glc_mrg + end subroutine prep_glc_mrg_lnd !================================================================================================ - subroutine prep_glc_merge( l2x_g, fractions_g, x2g_g ) + subroutine prep_glc_merge_lnd_forcing( l2x_g, fractions_g, x2g_g ) !----------------------------------------------------------------------- ! Description @@ -411,24 +575,18 @@ subroutine prep_glc_merge( l2x_g, fractions_g, x2g_g ) logical, save :: first_time = .true. character(CL),allocatable :: mrgstr(:) ! temporary string character(CL) :: field ! string converted to char - character(*), parameter :: subname = '(prep_glc_merge) ' + character(*), parameter :: subname = '(prep_glc_merge_lnd_forcing) ' !----------------------------------------------------------------------- call seq_comm_getdata(CPLID, iamroot=iamroot) lsize = mct_aVect_lsize(x2g_g) - num_flux_fields = shr_string_listGetNum(trim(seq_flds_x2g_fluxes)) - num_state_fields = shr_string_listGetNum(trim(seq_flds_x2g_states)) + num_flux_fields = shr_string_listGetNum(trim(seq_flds_x2g_fluxes_from_lnd)) + num_state_fields = shr_string_listGetNum(trim(seq_flds_x2g_states_from_lnd)) if (first_time) then - nflds = mct_aVect_nRattr(x2g_g) - if (nflds /= (num_flux_fields + num_state_fields)) then - write(logunit,*) subname,' ERROR: nflds /= num_flux_fields + num_state_fields: ', & - nflds, num_flux_fields, num_state_fields - call shr_sys_abort(subname//' ERROR: nflds /= num_flux_fields + num_state_fields') - end if - + nflds = num_flux_fields + num_state_fields allocate(mrgstr(nflds)) end if @@ -454,7 +612,7 @@ subroutine prep_glc_merge( l2x_g, fractions_g, x2g_g ) index_lfrac = mct_aVect_indexRA(fractions_g,"lfrac") do i = 1, num_flux_fields - call seq_flds_getField(field, i, seq_flds_x2g_fluxes) + call seq_flds_getField(field, i, seq_flds_x2g_fluxes_from_lnd) index_l2x = mct_aVect_indexRA(l2x_g, trim(field)) index_x2g = mct_aVect_indexRA(x2g_g, trim(field)) @@ -496,7 +654,34 @@ subroutine prep_glc_merge( l2x_g, fractions_g, x2g_g ) first_time = .false. - end subroutine prep_glc_merge + end subroutine prep_glc_merge_lnd_forcing + + + subroutine prep_glc_calc_o2x_gx(timer) + !--------------------------------------------------------------- + ! Description + ! Create o2x_gx + + ! Arguments + character(len=*), intent(in) :: timer + + character(*), parameter :: subname = '(prep_glc_calc_o2x_gx)' + ! Local Variables + integer eoi + type(mct_avect), pointer :: o2x_ox + + call t_drvstartf (trim(timer),barrier=mpicom_CPLID) + do eoi = 1,num_inst_ocn + o2x_ox => component_get_c2x_cx(ocn(eoi)) + call seq_map_map(mapper_So2g, o2x_ox, o2x_gx(eoi), & + fldlist=seq_flds_x2g_states_from_ocn,norm=.true.) + enddo + + call t_drvstopf (trim(timer)) + end subroutine prep_glc_calc_o2x_gx + + !================================================================================================ + !================================================================================================ @@ -522,8 +707,8 @@ subroutine prep_glc_calc_l2x_gx(fractions_lx, timer) call t_drvstartf (trim(timer),barrier=mpicom_CPLID) - num_flux_fields = shr_string_listGetNum(trim(seq_flds_x2g_fluxes)) - num_state_fields = shr_string_listGetNum(trim(seq_flds_x2g_states)) + num_flux_fields = shr_string_listGetNum(trim(seq_flds_x2g_fluxes_from_lnd)) + num_state_fields = shr_string_listGetNum(trim(seq_flds_x2g_states_from_lnd)) do egi = 1,num_inst_glc ! Use fortran mod to address ensembles in merge @@ -531,7 +716,7 @@ subroutine prep_glc_calc_l2x_gx(fractions_lx, timer) efi = mod((egi-1),num_inst_frc) + 1 do field_num = 1, num_flux_fields - call seq_flds_getField(fieldname, field_num, seq_flds_x2g_fluxes) + call seq_flds_getField(fieldname, field_num, seq_flds_x2g_fluxes_from_lnd) if (trim(fieldname) == qice_fieldname) then @@ -556,7 +741,7 @@ subroutine prep_glc_calc_l2x_gx(fractions_lx, timer) end do do field_num = 1, num_state_fields - call seq_flds_getField(fieldname, field_num, seq_flds_x2g_states) + call seq_flds_getField(fieldname, field_num, seq_flds_x2g_states_from_lnd) call prep_glc_map_one_state_field_lnd2glc(egi=egi, eli=eli, & fieldname = fieldname, & fractions_lx = fractions_lx(efi), & @@ -607,6 +792,136 @@ end subroutine prep_glc_map_one_state_field_lnd2glc !================================================================================================ + subroutine prep_glc_calculate_subshelf_boundary_fluxes + + !--------------------------------------------------------------- + ! Description + ! On the ice sheet grid, calculate shelf boundary fluxes + + use shr_const_mod , only: SHR_CONST_KAPPA_LAND_ICE + + ! Local Variables + + integer :: gsize, n, egi + type(mct_aVect), pointer :: o2x_ox ! Ocn export, ocn grid, cpl pes + type(mct_aVect), pointer :: x2g_gx ! Glc import, glc grid, cpl pes + type(mct_aVect), pointer :: g2x_gx ! Glc import, glc grid, cpl pes + + integer :: index_x2g_So_blt + integer :: index_x2g_So_bls + integer :: index_x2g_So_htv + integer :: index_x2g_So_stv + integer :: index_x2g_So_rhoeff + integer :: index_g2x_Sg_tbot + integer :: index_g2x_Sg_dztbot + integer :: index_g2x_Sg_lithop + integer :: index_g2x_Sg_icemask_floating + + integer :: index_g2x_Sg_blis + integer :: index_g2x_Sg_blit + integer :: index_g2x_Fogx_qiceho + integer :: index_g2x_Fogx_qicelo + integer :: index_x2g_Fogx_qiceli + integer :: index_x2g_Fogx_qicehi + + character(*), parameter :: subname = '(prep_glc_calculate_subshelf_boundary_fluxes)' + !--------------------------------------------------------------- + + if (.not.(glc_present)) return + + do egi = 1,num_inst_glc + + o2x_ox => component_get_c2x_cx(ocn(egi)) + g2x_gx => component_get_c2x_cx(glc(egi)) + x2g_gx => component_get_x2c_cx(glc(egi)) + + !Remap relevant ocean variables to ice sheet grid. + !Done here instead of in glc-frequency mapping so it happens within ocean coupling interval. + ! Also could map o2x_ox->o2x_gx(1) but using x2g_gx as destination allows us to see + ! these fields on the GLC grid of the coupler history file, which helps with debugging. + call seq_map_map(mapper_So2g, o2x_ox, x2g_gx, & + fldlist=seq_flds_x2g_states_from_ocn,norm=.true.) + + ! inputs to melt flux calculation + index_x2g_So_blt = mct_avect_indexra(x2g_gx,'So_blt',perrwith='quiet') + index_x2g_So_bls = mct_avect_indexra(x2g_gx,'So_bls',perrwith='quiet') + index_x2g_So_htv = mct_avect_indexra(x2g_gx,'So_htv',perrwith='quiet') + index_x2g_So_stv = mct_avect_indexra(x2g_gx,'So_stv',perrwith='quiet') + index_x2g_So_rhoeff = mct_avect_indexra(x2g_gx,'So_rhoeff',perrwith='quiet') + + index_g2x_Sg_tbot = mct_avect_indexra(g2x_gx,'Sg_tbot',perrwith='quiet') + index_g2x_Sg_dztbot = mct_avect_indexra(g2x_gx,'Sg_dztbot',perrwith='quiet') + index_g2x_Sg_lithop = mct_avect_indexra(g2x_gx,'Sg_lithop',perrwith='quiet') + index_g2x_Sg_icemask_floating = mct_avect_indexra(g2x_gx,'Sg_icemask_floating',perrwith='quiet') + + ! outputs to melt flux calculation + index_g2x_Sg_blis = mct_avect_indexra(g2x_gx,'Sg_blis',perrwith='quiet') + index_g2x_Sg_blit = mct_avect_indexra(g2x_gx,'Sg_blit',perrwith='quiet') + index_g2x_Fogx_qiceho = mct_avect_indexra(g2x_gx,'Fogx_qiceho',perrwith='quiet') + index_g2x_Fogx_qicelo = mct_avect_indexra(g2x_gx,'Fogx_qicelo',perrwith='quiet') + index_x2g_Fogx_qiceli = mct_avect_indexra(x2g_gx,'Fogx_qiceli',perrwith='quiet') + index_x2g_Fogx_qicehi = mct_avect_indexra(x2g_gx,'Fogx_qicehi',perrwith='quiet') + + gsize = mct_aVect_lsize(g2x_gx) + + do n=1,gsize + !Extract glc and ocn-sourced coupler fields used as input to compute_melt_fluxes to local arrays... + + ! Fields from the ocean, now on the GLC grid + oceanTemperature(n) = x2g_gx%rAttr(index_x2g_So_blt,n) + oceanSalinity(n) = x2g_gx%rAttr(index_x2g_So_bls,n) + oceanHeatTransferVelocity(n) = x2g_gx%rAttr(index_x2g_So_htv,n) + oceanSaltTransferVelocity(n) = x2g_gx%rAttr(index_x2g_So_stv,n) + + ! Fields from the ice sheet model (still on the GLC grid) + iceTemperature(n) = g2x_gx%rAttr(index_g2x_Sg_tbot,n) + iceTemperatureDistance(n) = g2x_gx%rAttr(index_g2x_Sg_dztbot,n) + interfacePressure(n) = g2x_gx%rAttr(index_g2x_Sg_lithop,n) + iceFloatingMask(n) = g2x_gx%rAttr(index_g2x_Sg_icemask_floating,n) + + !... initialize local compute_melt_fluxes output arrays... + outInterfaceSalinity(n) = 0.0_r8 + outInterfaceTemperature(n) = 0.0_r8 + outFreshwaterFlux(n) = 0.0_r8 + outOceanHeatFlux(n) = 0.0_r8 + outIceHeatFlux(n) = 0.0_r8 + end do + + !...calculate fluxes... + call compute_melt_fluxes(oceanTemperature=oceanTemperature,& + oceanSalinity=oceanSalinity,& + oceanHeatTransferVelocity=oceanHeatTransferVelocity,& + oceanSaltTransferVelocity=oceanSaltTransferVelocity,& + interfacePressure=interfacePressure,& + iceTemperature=iceTemperature,& + iceTemperatureDistance=iceTemperatureDistance, & + iceFloatingMask=iceFloatingMask, & + outInterfaceSalinity=outInterfaceSalinity,& + outInterfaceTemperature=outInterfaceTemperature,& + outFreshwaterFlux=outFreshwaterFlux,& + outOceanHeatFlux=outOceanHeatFlux,& + outIceHeatFlux=outIceHeatFlux,& + gsize=gsize) + + !...and assign fluxes to glc and ocn-directed coupler fields + do n=1,gsize + !Assign outputs from compute_melt_fluxes back into coupler attributes + g2x_gx%rAttr(index_g2x_Sg_blis,n) = outInterfaceSalinity(n) !to ocean + g2x_gx%rAttr(index_g2x_Sg_blit,n) = outInterfaceTemperature(n) !to ocean + g2x_gx%rAttr(index_g2x_Fogx_qiceho,n) = outOceanHeatFlux(n) !to ocean + g2x_gx%rAttr(index_g2x_Fogx_qicelo,n)= outFreshwaterFlux(n) !to ocean + x2g_gx%rAttr(index_x2g_Fogx_qicehi,n) = outIceHeatFlux(n) !to ice sheet + x2g_gx%rAttr(index_x2g_Fogx_qiceli,n) = -1.0_r8 * outFreshwaterFlux(n) !to ice sheet + end do + + !Note: remap ocean-side outputs back onto ocean grid done in call to prep_ocn_shelf_calc_g2x_ox + + end do ! loop over GLC instances + + end subroutine prep_glc_calculate_subshelf_boundary_fluxes + + !================================================================================================ + subroutine prep_glc_zero_fields() !--------------------------------------------------------------- @@ -1098,6 +1413,21 @@ function prep_glc_get_l2gacc_lx_cnt() prep_glc_get_l2gacc_lx_cnt => l2gacc_lx_cnt end function prep_glc_get_l2gacc_lx_cnt + function prep_glc_get_o2x_gx() + type(mct_aVect), pointer :: prep_glc_get_o2x_gx(:) + prep_glc_get_o2x_gx => o2x_gx(:) + end function prep_glc_get_o2x_gx + + function prep_glc_get_x2gacc_gx() + type(mct_aVect), pointer :: prep_glc_get_x2gacc_gx(:) + prep_glc_get_x2gacc_gx => x2gacc_gx(:) + end function prep_glc_get_x2gacc_gx + + function prep_glc_get_x2gacc_gx_cnt() + integer, pointer :: prep_glc_get_x2gacc_gx_cnt + prep_glc_get_x2gacc_gx_cnt => x2gacc_gx_cnt + end function prep_glc_get_x2gacc_gx_cnt + function prep_glc_get_mapper_Sl2g() type(seq_map), pointer :: prep_glc_get_mapper_Sl2g prep_glc_get_mapper_Sl2g => mapper_Sl2g @@ -1108,4 +1438,175 @@ function prep_glc_get_mapper_Fl2g() prep_glc_get_mapper_Fl2g => mapper_Fl2g end function prep_glc_get_mapper_Fl2g + function prep_glc_get_mapper_So2g() + type(seq_map), pointer :: prep_glc_get_mapper_So2g + prep_glc_get_mapper_So2g=> mapper_So2g + end function prep_glc_get_mapper_So2g + + function prep_glc_get_mapper_Fo2g() + type(seq_map), pointer :: prep_glc_get_mapper_Fo2g + prep_glc_get_mapper_Fo2g=> mapper_Fo2g + end function prep_glc_get_mapper_Fo2g + +!*********************************************************************** +! +! routine compute_melt_fluxes +! +!> \brief Computes ocean and ice melt fluxes, etc. +!> \author Xylar Asay-Davis +!> \date 3/27/2015 +!> This routine computes melt fluxes (melt rate, temperature fluxes +!> into the ice and the ocean, and salt flux) as well as the interface +!> temperature and salinity. This routine expects an ice temperature +!> in the bottom layer of ice and ocean temperature and salinity in +!> the top ocean layer as well as the pressure at the ice/ocean interface. +!> +!> The ocean heat and salt transfer velocities are determined based on +!> observations of turbulent mixing rates in the under-ice boundary layer. +!> They should be the product of the friction velocity and a (possibly +!> spatially variable) non-dimenional transfer coefficient. +!> +!> The iceTemperatureDistance is the distance between the location +!> where the iceTemperature is supplied and the ice-ocean interface, +!> used to compute a temperature gradient. The ice thermal conductivity, +!> SHR_CONST_KAPPA_LAND_ICE, is zero for the freezing solution from Holland and Jenkins +!> (1999) in which the ice is purely insulating. +! +!----------------------------------------------------------------------- + + subroutine compute_melt_fluxes( & + oceanTemperature, & + oceanSalinity, & + oceanHeatTransferVelocity, & + oceanSaltTransferVelocity, & + interfacePressure, & + iceTemperature, & + iceTemperatureDistance, & + iceFloatingMask, & + outInterfaceSalinity, & + outInterfaceTemperature, & + outFreshwaterFlux, & + outOceanHeatFlux, & + outIceHeatFlux, & + gsize) + + use shr_const_mod, only: SHR_CONST_CPICE, & + SHR_CONST_CPSW, & + SHR_CONST_LATICE, & + SHR_CONST_RHOICE, & + SHR_CONST_RHOSW, & + SHR_CONST_DTF_DP, & + SHR_CONST_DTF_DS, & + SHR_CONST_DTF_DPDS, & + SHR_CONST_TF0, & + SHR_CONST_KAPPA_LAND_ICE + + !----------------------------------------------------------------- + ! + ! input variables + ! + !----------------------------------------------------------------- + + real (kind=r8), dimension(:), intent(in) :: & + oceanTemperature, & !< Input: ocean temperature in top layer + oceanSalinity, & !< Input: ocean salinity in top layer + oceanHeatTransferVelocity, & !< Input: ocean heat transfer velocity + oceanSaltTransferVelocity, & !< Input: ocean salt transfer velocity + interfacePressure, & !< Input: pressure at the ice-ocean interface + iceTemperature, & !< Input: ice temperature in bottom layer + iceTemperatureDistance !< Input: distance to ice temperature from ice-ocean interface + integer, dimension(:), intent(in) :: & + iceFloatingMask !< Input: mask of cells that contain floating ice + + integer, intent(in) :: gsize !< Input: number of values in each array + + !----------------------------------------------------------------- + ! + ! output variables + ! + !----------------------------------------------------------------- + + real (kind=r8), dimension(:), intent(out) :: & + outInterfaceSalinity, & !< Output: ocean salinity at the interface + outInterfaceTemperature, & !< Output: ice/ocean temperature at the interface + outFreshwaterFlux, & !< Output: ocean thickness flux (melt rate) + outOceanHeatFlux, & !< Output: the temperature flux into the ocean + outIceHeatFlux !< Output: the temperature flux into the ice + + !----------------------------------------------------------------- + ! + ! local variables + ! + !----------------------------------------------------------------- + + real (kind=r8) :: T0, transferVelocityRatio, Tlatent, nu, a, b, c, eta, & + iceHeatFluxCoeff, iceDeltaT, dTf_dS + integer :: n + character(*), parameter :: subname = '(compute_melt_fluxes)' + + real (kind=r8), parameter :: minInterfaceSalinity = 0.001_r8 + + real (kind=r8), parameter :: referencePressure = 0.0_r8 ! Using reference pressure of 0 + + real (kind=r8) :: pressureOffset + + Tlatent = SHR_CONST_LATICE/SHR_CONST_CPSW + do n = 1, gsize + if (iceFloatingMask(n) == 0) cycle ! Only calculate on floating cells + + if (oceanHeatTransferVelocity(n) == 0.0_r8) then + write(logunit,*) 'compute_melt_fluxes ERROR: oceanHeatTransferVelocity value of 0 causes divide by 0 at index ', n + call shr_sys_abort('compute_melt_fluxes ERROR: oceanHeatTransferVelocity value of 0 causes divide by 0') + end if + + iceHeatFluxCoeff = SHR_CONST_RHOICE*SHR_CONST_CPICE*SHR_CONST_KAPPA_LAND_ICE/iceTemperatureDistance(n) + nu = iceHeatFluxCoeff/(SHR_CONST_RHOSW*SHR_CONST_CPSW*oceanHeatTransferVelocity(n)) + pressureOffset = max(interfacePressure(n) - referencePressure, 0.0_r8) + T0 = SHR_CONST_TF0 + SHR_CONST_DTF_DP * pressureOffset + !Note: These two terms for T0 are not needed because we are evaluating at salinity=0: + !+ SHR_CONST_DTF_DS * oceanSalinity(n) + SHR_CONST_DTF_DPDS * pressureOffset * oceanSalinity(n) + iceDeltaT = T0 - iceTemperature(n) + dTf_dS = SHR_CONST_DTF_DS + SHR_CONST_DTF_DPDS * pressureOffset + + transferVelocityRatio = oceanSaltTransferVelocity(n)/oceanHeatTransferVelocity(n) + + a = -1.0_r8 * dTf_dS * (1.0_r8 + nu) + b = transferVelocityRatio*Tlatent - nu*iceDeltaT + oceanTemperature(n) - T0 + c = -transferVelocityRatio*Tlatent*max(oceanSalinity(n), 0.0_r8) + ! a is non-negative; c is strictly non-positive so we never get imaginary roots. + ! Since a can be zero, we need a solution of the quadratic equation for 1/Si instead of Si. + ! Following: https://people.csail.mit.edu/bkph/articles/Quadratics.pdf + ! Since a and -c are are non-negative, the term in the square root is also always >= |b|. + ! In all reasonable cases, b will be strictly positive, since transferVelocityRatio*Tlatent ~ 2 C, + ! T0 ~ -1.8 C and oceanTemperature should never be able to get below about -3 C + ! As long as either b or both a and c are greater than zero, the strictly non-negative root is + outInterfaceSalinity(n) = max(-(2.0_r8*c)/(b + sqrt(b**2 - 4.0_r8*a*c)), minInterfaceSalinity) + + outInterfaceTemperature(n) = dTf_dS*outInterfaceSalinity(n)+T0 + + outFreshwaterFlux(n) = SHR_CONST_RHOSW*oceanSaltTransferVelocity(n) & + * (oceanSalinity(n)/outInterfaceSalinity(n) - 1.0_r8) + + ! According to Jenkins et al. (2001), the temperature fluxes into the ocean are: + ! 1. the advection of meltwater into the top layer (or removal for freezing) + ! 2. the turbulent transfer of heat across the boundary layer, based on the termal driving + outOceanHeatFlux(n) = SHR_CONST_CPSW*(outFreshwaterFlux(n)*outInterfaceTemperature(n) & + - SHR_CONST_RHOSW*oceanHeatTransferVelocity(n)*(oceanTemperature(n)-outInterfaceTemperature(n))) + + ! the temperature fluxes into the ice are: + ! 1. the advection of ice at the interface temperature out of the domain due to melting + ! (or in due to freezing) + ! 2. the diffusion (if any) of heat into the ice, based on temperature difference between + ! the reference point in the ice (either the surface or the middle of the bottom layer) + ! and the interface + outIceHeatFlux(n) = -SHR_CONST_CPICE*outFreshwaterFlux(n)*outInterfaceTemperature(n) + + outIceHeatFlux(n) = outIceHeatFlux(n) & + - iceHeatFluxCoeff*(iceTemperature(n) - outInterfaceTemperature(n)) + + end do + + !-------------------------------------------------------------------- + end subroutine compute_melt_fluxes + end module prep_glc_mod diff --git a/src/drivers/mct/main/prep_ice_mod.F90 b/src/drivers/mct/main/prep_ice_mod.F90 index 5aaba8ff207..36c478f6fc2 100644 --- a/src/drivers/mct/main/prep_ice_mod.F90 +++ b/src/drivers/mct/main/prep_ice_mod.F90 @@ -33,6 +33,7 @@ module prep_ice_mod public :: prep_ice_calc_o2x_ix public :: prep_ice_calc_r2x_ix public :: prep_ice_calc_g2x_ix + public :: prep_ice_shelf_calc_g2x_ix public :: prep_ice_get_a2x_ix public :: prep_ice_get_o2x_ix @@ -41,6 +42,8 @@ module prep_ice_mod public :: prep_ice_get_mapper_SFo2i public :: prep_ice_get_mapper_Rg2i + public :: prep_ice_get_mapper_Sg2i + public :: prep_ice_get_mapper_Fg2i !-------------------------------------------------------------------------- ! Private interfaces @@ -55,6 +58,8 @@ module prep_ice_mod ! mappers type(seq_map), pointer :: mapper_SFo2i type(seq_map), pointer :: mapper_Rg2i + type(seq_map), pointer :: mapper_Sg2i + type(seq_map), pointer :: mapper_Fg2i type(seq_map), pointer :: mapper_Rr2i ! attribute vectors @@ -71,7 +76,7 @@ module prep_ice_mod !================================================================================================ - subroutine prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, rof_c2_ice) + subroutine prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, glcshelf_c2_ice, rof_c2_ice) !--------------------------------------------------------------- ! Description @@ -82,6 +87,7 @@ subroutine prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, rof_c2_ice) type (seq_infodata_type) , intent(in) :: infodata logical, intent(in) :: ocn_c2_ice ! .true. => ocn to ice coupling on logical, intent(in) :: glc_c2_ice ! .true. => glc to ice coupling on + logical, intent(in) :: glcshelf_c2_ice ! .true. => glc ice shelf to ice coupling on logical, intent(in) :: rof_c2_ice ! .true. => rof to ice coupling on ! ! Local Variables @@ -111,6 +117,8 @@ subroutine prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, rof_c2_ice) allocate(mapper_SFo2i) allocate(mapper_Rg2i) + allocate(mapper_Sg2i) + allocate(mapper_Fg2i) allocate(mapper_Rr2i) if (ice_present) then @@ -165,6 +173,24 @@ subroutine prep_ice_init(infodata, ocn_c2_ice, glc_c2_ice, rof_c2_ice) 'mapper_Rg2i initialization', esmf_map_flag) endif + if (glcshelf_c2_ice) then + if (iamroot_CPLID) then + write(logunit,*) ' ' + write(logunit,F00) 'Initializing mapper_Sg2i' + end if + call seq_map_init_rcfile(mapper_Sg2i, glc(1), ice(1), & + 'seq_maps.rc','glc2ice_smapname:','glc2ice_smaptype:',samegrid_ig, & + 'mapper_Sg2i initialization', esmf_map_flag) + + if (iamroot_CPLID) then + write(logunit,*) ' ' + write(logunit,F00) 'Initializing mapper_Fg2i' + end if + call seq_map_init_rcfile(mapper_Fg2i, glc(1), ice(1), & + 'seq_maps.rc','glc2ice_fmapname:','glc2ice_fmaptype:',samegrid_ig, & + 'mapper_Fg2i initialization', esmf_map_flag) + endif + if (rof_c2_ice) then if (iamroot_CPLID) then write(logunit,*) ' ' @@ -534,7 +560,8 @@ subroutine prep_ice_calc_g2x_ix(timer) call t_drvstartf (trim(timer),barrier=mpicom_CPLID) do egi = 1,num_inst_glc g2x_gx => component_get_c2x_cx(glc(egi)) - call seq_map_map(mapper_Rg2i, g2x_gx, g2x_ix(egi), norm=.true.) + call seq_map_map(mapper_Rg2i, g2x_gx, g2x_ix(egi), & + fldlist='Fixx_rofi', norm=.true.) enddo call t_drvstopf (trim(timer)) @@ -542,6 +569,32 @@ end subroutine prep_ice_calc_g2x_ix !================================================================================================ + subroutine prep_ice_shelf_calc_g2x_ix(timer) + !--------------------------------------------------------------- + ! Description + ! Create g2x_ix (note that g2x_ix is a local module variable) + ! + ! Arguments + character(len=*), intent(in) :: timer + ! + ! Local Variables + integer :: egi + type(mct_aVect), pointer :: g2x_gx + character(*), parameter :: subname = '(prep_ice_calc_g2x_ix)' + !--------------------------------------------------------------- + + call t_drvstartf (trim(timer),barrier=mpicom_CPLID) + do egi = 1,num_inst_rof + g2x_gx => component_get_c2x_cx(glc(egi)) + call seq_map_map(mapper_Sg2i, g2x_gx, g2x_ix(egi), & + fldlist='Sg_icemask_coupled_fluxes', norm=.true.) + enddo + call t_drvstopf (trim(timer)) + + end subroutine prep_ice_shelf_calc_g2x_ix + + !================================================================================================ + function prep_ice_get_a2x_ix() type(mct_aVect), pointer :: prep_ice_get_a2x_ix(:) prep_ice_get_a2x_ix => a2x_ix(:) @@ -572,4 +625,14 @@ function prep_ice_get_mapper_Rg2i() prep_ice_get_mapper_Rg2i => mapper_Rg2i end function prep_ice_get_mapper_Rg2i + function prep_ice_get_mapper_Sg2i() + type(seq_map), pointer :: prep_ice_get_mapper_Sg2i + prep_ice_get_mapper_Sg2i => mapper_Sg2i + end function prep_ice_get_mapper_Sg2i + + function prep_ice_get_mapper_Fg2i() + type(seq_map), pointer :: prep_ice_get_mapper_Fg2i + prep_ice_get_mapper_Fg2i => mapper_Fg2i + end function prep_ice_get_mapper_Fg2i + end module prep_ice_mod diff --git a/src/drivers/mct/main/prep_ocn_mod.F90 b/src/drivers/mct/main/prep_ocn_mod.F90 index 4873dfd6437..e4f36146ea9 100644 --- a/src/drivers/mct/main/prep_ocn_mod.F90 +++ b/src/drivers/mct/main/prep_ocn_mod.F90 @@ -38,6 +38,7 @@ module prep_ocn_mod public :: prep_ocn_calc_i2x_ox public :: prep_ocn_calc_r2x_ox public :: prep_ocn_calc_g2x_ox + public :: prep_ocn_shelf_calc_g2x_ox public :: prep_ocn_calc_w2x_ox public :: prep_ocn_get_a2x_ox @@ -62,6 +63,8 @@ module prep_ocn_mod public :: prep_ocn_get_mapper_SFi2o public :: prep_ocn_get_mapper_Rg2o_liq public :: prep_ocn_get_mapper_Rg2o_ice + public :: prep_ocn_get_mapper_Sg2o + public :: prep_ocn_get_mapper_Fg2o public :: prep_ocn_get_mapper_Sw2o !-------------------------------------------------------------------------- @@ -84,6 +87,8 @@ module prep_ocn_mod type(seq_map), pointer :: mapper_SFi2o type(seq_map), pointer :: mapper_Rg2o_liq type(seq_map), pointer :: mapper_Rg2o_ice + type(seq_map), pointer :: mapper_Fg2o + type(seq_map), pointer :: mapper_Sg2o type(seq_map), pointer :: mapper_Sw2o ! attribute vectors @@ -115,7 +120,7 @@ module prep_ocn_mod !================================================================================================ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_ocn, & - wav_c2_ocn, glc_c2_ocn) + wav_c2_ocn, glc_c2_ocn, glcshelf_c2_ocn) !--------------------------------------------------------------- ! Description @@ -130,6 +135,7 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc logical , intent(in) :: rof_c2_ocn ! .true.=>rof to ocn coupling on logical , intent(in) :: wav_c2_ocn ! .true.=>wav to ocn coupling on logical , intent(in) :: glc_c2_ocn ! .true.=>glc to ocn coupling on + logical , intent(in) :: glcshelf_c2_ocn ! .true.=>glc ice shelf to ocn coupling on ! ! Local Variables logical :: esmf_map_flag ! .true. => use esmf for mapping @@ -181,6 +187,8 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc allocate(mapper_SFi2o) allocate(mapper_Rg2o_liq) allocate(mapper_Rg2o_ice) + allocate(mapper_Sg2o) + allocate(mapper_Fg2o) allocate(mapper_Sw2o) if (ocn_present) then @@ -348,6 +356,24 @@ subroutine prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_oc endif call shr_sys_flush(logunit) + if (glcshelf_c2_ocn) then !ice shelf coupled properties + if (iamroot_CPLID) then + write(logunit,*) ' ' + write(logunit,F00) 'Initializing mapper_Sg2o' + end if + call seq_map_init_rcfile(mapper_Sg2o, glc(1), ocn(1), & + 'seq_maps.rc', 'glc2ocn_smapname:', 'glc2ocn_smaptype:',samegrid_og, & + 'mapper_Sg2o initialization',esmf_map_flag) + if (iamroot_CPLID) then + write(logunit,*) ' ' + write(logunit,F00) 'Initializing mapper_Fg2o' + end if + call seq_map_init_rcfile(mapper_Fg2o, glc(1), ocn(1), & + 'seq_maps.rc', 'glc2ocn_fmapname:', 'glc2ocn_fmaptype:',samegrid_og, & + 'mapper_Fg2o initialization',esmf_map_flag) + endif + call shr_sys_flush(logunit) + if (wav_c2_ocn) then if (iamroot_CPLID) then write(logunit,*) ' ' @@ -507,6 +533,8 @@ end subroutine prep_ocn_mrg subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xao_o, & fractions_o, x2o_o ) + use prep_glc_mod, only: prep_glc_calculate_subshelf_boundary_fluxes + !----------------------------------------------------------------------- ! ! Arguments @@ -524,7 +552,7 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa integer :: n,ka,ki,ko,kr,kw,kx,kir,kor,i,i1,o1 integer :: kof,kif integer :: lsize - integer :: noflds,naflds,niflds,nrflds,nwflds,nxflds + integer :: noflds,naflds,niflds,nrflds,nwflds,nxflds,ngflds real(r8) :: ifrac,ifracr real(r8) :: afrac,afracr real(r8) :: frac_sum @@ -536,12 +564,14 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa character(CL),allocatable :: field_rof(:) ! string converted to char character(CL),allocatable :: field_wav(:) ! string converted to char character(CL),allocatable :: field_xao(:) ! string converted to char + character(CL),allocatable :: field_glc(:) ! string converted to char character(CL),allocatable :: itemc_ocn(:) ! string converted to char character(CL),allocatable :: itemc_atm(:) ! string converted to char character(CL),allocatable :: itemc_ice(:) ! string converted to char character(CL),allocatable :: itemc_rof(:) ! string converted to char character(CL),allocatable :: itemc_wav(:) ! string converted to char character(CL),allocatable :: itemc_xao(:) ! string converted to char + character(CL),allocatable :: itemc_g2x(:) ! string converted to char integer, save :: index_a2x_Faxa_swvdr integer, save :: index_a2x_Faxa_swvdf integer, save :: index_a2x_Faxa_swndr @@ -611,6 +641,7 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa type(mct_aVect_sharedindices),save :: r2x_sharedindices type(mct_aVect_sharedindices),save :: w2x_sharedindices type(mct_aVect_sharedindices),save :: xao_sharedindices + type(mct_aVect_sharedindices),save :: g2x_sharedindices logical, save :: first_time = .true. character(*),parameter :: subName = '(prep_ocn_merge) ' !----------------------------------------------------------------------- @@ -623,6 +654,7 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa nrflds = mct_aVect_nRattr(r2x_o) nwflds = mct_aVect_nRattr(w2x_o) nxflds = mct_aVect_nRattr(xao_o) + ngflds = mct_aVect_nRattr(g2x_o) if (first_time) then index_a2x_Faxa_swvdr = mct_aVect_indexRA(a2x_o,'Faxa_swvdr') @@ -714,6 +746,7 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa allocate(field_rof(nrflds), itemc_rof(nrflds)) allocate(field_wav(nwflds), itemc_wav(nwflds)) allocate(field_xao(nxflds), itemc_xao(nxflds)) + allocate(field_glc(ngflds), itemc_g2x(ngflds)) allocate(mrgstr(noflds)) aindx(:) = 0 iindx(:) = 0 @@ -746,12 +779,17 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa field_xao(kx) = mct_aVect_getRList2c(kx, xao_o) itemc_xao(kx) = trim(field_xao(kx)(scan(field_xao(kx),'_'):)) enddo + do kx = 1,ngflds + field_glc(kx) = mct_aVect_getRList2c(kx, g2x_o) + itemc_g2x(kx) = trim(field_glc(kx)(scan(field_glc(kx),'_'):)) + enddo call mct_aVect_setSharedIndices(a2x_o, x2o_o, a2x_SharedIndices) call mct_aVect_setSharedIndices(i2x_o, x2o_o, i2x_SharedIndices) call mct_aVect_setSharedIndices(r2x_o, x2o_o, r2x_SharedIndices) call mct_aVect_setSharedIndices(w2x_o, x2o_o, w2x_SharedIndices) call mct_aVect_setSharedIndices(xao_o, x2o_o, xao_SharedIndices) + call mct_aVect_setSharedIndices(g2x_o, x2o_o, g2x_SharedIndices) do ko = 1,noflds !--- document merge --- @@ -876,6 +914,11 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa o1=xao_SharedIndices%shared_real%aVindices2(i) mrgstr(o1) = trim(mrgstr(o1))//' = xao%'//trim(field_xao(i1)) enddo + do i=1,g2x_SharedIndices%shared_real%num_indices + i1=g2x_SharedIndices%shared_real%aVindices1(i) + o1=g2x_SharedIndices%shared_real%aVindices2(i) + mrgstr(o1) = trim(mrgstr(o1))//' = g2x%'//trim(field_glc(i1)) + enddo endif ! call mct_aVect_copy(aVin=a2x_o, aVout=x2o_o, vector=mct_usevector) @@ -888,6 +931,7 @@ subroutine prep_ocn_merge( flux_epbalfact, a2x_o, i2x_o, r2x_o, w2x_o, g2x_o, xa call mct_aVect_copy(aVin=r2x_o, aVout=x2o_o, vector=mct_usevector, sharedIndices=r2x_SharedIndices) call mct_aVect_copy(aVin=w2x_o, aVout=x2o_o, vector=mct_usevector, sharedIndices=w2x_SharedIndices) call mct_aVect_copy(aVin=xao_o, aVout=x2o_o, vector=mct_usevector, sharedIndices=xao_SharedIndices) + call mct_aVect_copy(aVin=g2x_o, aVout=x2o_o, vector=mct_usevector, sharedIndices=g2x_SharedIndices) !--- document manual merges --- if (first_time) then @@ -1184,7 +1228,7 @@ end subroutine prep_ocn_calc_a2x_ox subroutine prep_ocn_calc_i2x_ox(timer) !--------------------------------------------------------------- ! Description - ! Create g2x_ox (note that i2x_ox is a local module variable) + ! Create i2x_ox (note that i2x_ox is a local module variable) ! ! Arguments character(len=*) , intent(in) :: timer @@ -1268,6 +1312,35 @@ end subroutine prep_ocn_calc_g2x_ox !================================================================================================ + subroutine prep_ocn_shelf_calc_g2x_ox(timer) + !--------------------------------------------------------------- + ! Description + ! Create g2x_ox (note that g2x_ox is a local module variable) + ! + ! Arguments + character(len=*), intent(in) :: timer + ! + ! Local Variables + integer :: egi + type(mct_avect), pointer :: g2x_gx + character(*), parameter :: subname = '(prep_ocn_calc_g2x_ox)' + !--------------------------------------------------------------- + + call t_drvstartf (trim(timer),barrier=mpicom_CPLID) + do egi = 1,num_inst_glc + g2x_gx => component_get_c2x_cx(glc(egi)) + + call seq_map_map(mapper_Sg2o, g2x_gx, g2x_ox(egi), norm=.true.) + + call seq_map_map(mapper_Fg2o, g2x_gx, g2x_ox(egi),norm=.true.) + + + enddo + call t_drvstopf (trim(timer)) + end subroutine prep_ocn_shelf_calc_g2x_ox + + !================================================================================================ + subroutine prep_ocn_calc_w2x_ox(timer) !--------------------------------------------------------------- ! Description @@ -1372,6 +1445,16 @@ function prep_ocn_get_mapper_Rg2o_ice() prep_ocn_get_mapper_Rg2o_ice => mapper_Rg2o_ice end function prep_ocn_get_mapper_Rg2o_ice + function prep_ocn_get_mapper_Sg2o() + type(seq_map), pointer :: prep_ocn_get_mapper_Sg2o + prep_ocn_get_mapper_Sg2o => mapper_Sg2o + end function prep_ocn_get_mapper_Sg2o + + function prep_ocn_get_mapper_Fg2o() + type(seq_map), pointer :: prep_ocn_get_mapper_Fg2o + prep_ocn_get_mapper_Fg2o => mapper_Fg2o + end function prep_ocn_get_mapper_Fg2o + function prep_ocn_get_mapper_Sw2o() type(seq_map), pointer :: prep_ocn_get_mapper_Sw2o prep_ocn_get_mapper_Sw2o => mapper_Sw2o diff --git a/src/drivers/mct/main/seq_rest_mod.F90 b/src/drivers/mct/main/seq_rest_mod.F90 index f97b4ca5141..12437a4d433 100644 --- a/src/drivers/mct/main/seq_rest_mod.F90 +++ b/src/drivers/mct/main/seq_rest_mod.F90 @@ -62,6 +62,9 @@ module seq_rest_mod use prep_rof_mod, only: prep_rof_get_l2racc_lx_cnt use prep_glc_mod, only: prep_glc_get_l2gacc_lx use prep_glc_mod, only: prep_glc_get_l2gacc_lx_cnt + use prep_glc_mod, only: prep_glc_get_x2gacc_gx + use prep_glc_mod, only: prep_glc_get_x2gacc_gx_cnt + use prep_aoflux_mod, only: prep_aoflux_get_xao_ox use prep_aoflux_mod, only: prep_aoflux_get_xao_ax @@ -117,6 +120,8 @@ module seq_rest_mod logical :: esp_prognostic ! .true. => esp comp expects input logical :: iac_prognostic ! .true. => iac comp expects input + logical :: ocn_c2_glcshelf ! .true. => ocn to glcshelf coupling on + !--- temporary pointers --- type(mct_gsMap), pointer :: gsmap type(mct_aVect), pointer :: x2oacc_ox(:) @@ -125,6 +130,8 @@ module seq_rest_mod integer , pointer :: l2racc_lx_cnt type(mct_aVect), pointer :: l2gacc_lx(:) integer , pointer :: l2gacc_lx_cnt + type(mct_aVect), pointer :: x2gacc_gx(:) + integer , pointer :: x2gacc_gx_cnt type(mct_aVect), pointer :: xao_ox(:) type(mct_aVect), pointer :: xao_ax(:) @@ -198,7 +205,8 @@ subroutine seq_rest_read(rest_file, infodata, & glc_prognostic=glc_prognostic, & wav_prognostic=wav_prognostic, & iac_prognostic=iac_prognostic, & - esp_prognostic=esp_prognostic) + esp_prognostic=esp_prognostic, & + ocn_c2_glcshelf=ocn_c2_glcshelf) if (iamin_CPLID) then if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) @@ -227,6 +235,15 @@ subroutine seq_rest_read(rest_file, infodata, & call seq_io_read(rest_file, gsmap, l2gacc_lx, 'l2gacc_lx') call seq_io_read(rest_file, l2gacc_lx_cnt ,'l2gacc_lx_cnt') end if + + if (ocn_c2_glcshelf) then + gsmap => component_get_gsmap_cx(glc(1)) + x2gacc_gx => prep_glc_get_x2gacc_gx() + x2gacc_gx_cnt => prep_glc_get_x2gacc_gx_cnt() + call seq_io_read(rest_file, gsmap, x2gacc_gx, 'x2gacc_gx') + call seq_io_read(rest_file, x2gacc_gx_cnt ,'x2gacc_gx_cnt') + end if + if (ocn_present) then gsmap => component_get_gsmap_cx(ocn(1)) x2oacc_ox => prep_ocn_get_x2oacc_ox() @@ -381,6 +398,7 @@ subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & wav_prognostic=wav_prognostic, & esp_prognostic=esp_prognostic, & iac_prognostic=iac_prognostic, & + ocn_c2_glcshelf=ocn_c2_glcshelf, & case_name=case_name, & model_doi_url=model_doi_url) @@ -496,6 +514,15 @@ subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & call seq_io_write(rest_file, l2gacc_lx_cnt, 'l2gacc_lx_cnt', & whead=whead, wdata=wdata) end if + if (ocn_c2_glcshelf) then + gsmap => component_get_gsmap_cx(glc(1)) + x2gacc_gx => prep_glc_get_x2gacc_gx() + x2gacc_gx_cnt => prep_glc_get_x2gacc_gx_cnt() + call seq_io_write(rest_file, gsmap, x2gacc_gx , 'x2gacc_gx', & + whead=whead, wdata=wdata) + call seq_io_write(rest_file, x2gacc_gx_cnt, 'x2gacc_gx_cnt', & + whead=whead, wdata=wdata) + end if if (ocn_present) then gsmap => component_get_gsmap_cx(ocn(1)) x2oacc_ox => prep_ocn_get_x2oacc_ox() diff --git a/src/drivers/mct/shr/seq_flds_mod.F90 b/src/drivers/mct/shr/seq_flds_mod.F90 index 3a21de4824f..02b6cd1851f 100644 --- a/src/drivers/mct/shr/seq_flds_mod.F90 +++ b/src/drivers/mct/shr/seq_flds_mod.F90 @@ -193,7 +193,10 @@ module seq_flds_mod character(CXX) :: seq_flds_g2o_liq_fluxes character(CXX) :: seq_flds_g2o_ice_fluxes character(CXX) :: seq_flds_x2g_states + character(CXX) :: seq_flds_x2g_states_from_lnd + character(CXX) :: seq_flds_x2g_states_from_ocn character(CXX) :: seq_flds_x2g_fluxes + character(CXX) :: seq_flds_x2g_fluxes_from_lnd character(CXX) :: seq_flds_w2x_states character(CXX) :: seq_flds_w2x_fluxes @@ -318,7 +321,10 @@ subroutine seq_flds_set(nmlfile, ID, infodata) character(CXX) :: g2o_liq_fluxes = '' character(CXX) :: g2o_ice_fluxes = '' character(CXX) :: x2g_states = '' + character(CXX) :: x2g_states_from_lnd = '' + character(CXX) :: x2g_states_from_ocn = '' character(CXX) :: x2g_fluxes = '' + character(CXX) :: x2g_fluxes_from_lnd = '' character(CXX) :: xao_albedo = '' character(CXX) :: xao_states = '' character(CXX) :: xao_fluxes = '' @@ -2297,6 +2303,9 @@ subroutine seq_flds_set(nmlfile, ID, infodata) call seq_flds_add(g2x_states_to_lnd,trim(name)) call seq_flds_add(x2l_states,trim(name)) call seq_flds_add(x2l_states_from_glc,trim(name)) + if (trim(cime_model) == 'e3sm') then + call seq_flds_add(x2o_states,trim(name)) + endif longname = 'Ice sheet grid coverage on global grid' stdname = 'ice_sheet_grid_mask' units = '1' @@ -2334,6 +2343,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) call set_glc_elevclass_field(name, attname, longname, stdname, units, l2x_fluxes_to_glc, & additional_list = .true.) call seq_flds_add(x2g_fluxes,trim(name)) + call seq_flds_add(x2g_fluxes_from_lnd,trim(name)) call metadata_set(attname, longname, stdname, units) name = 'Sl_tsrf' @@ -2345,6 +2355,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) call set_glc_elevclass_field(name, attname, longname, stdname, units, l2x_states_to_glc, & additional_list = .true.) call seq_flds_add(x2g_states,trim(name)) + call seq_flds_add(x2g_states_from_lnd,trim(name)) call metadata_set(attname, longname, stdname, units) ! Sl_topo is sent from lnd -> cpl, but is NOT sent to glc (it is only used for the @@ -2399,6 +2410,155 @@ subroutine seq_flds_set(nmlfile, ID, infodata) call set_glc_elevclass_field(name, attname, longname, stdname, units, x2l_fluxes_from_glc, & additional_list = .true.) + if (trim(cime_model) == 'e3sm') then + name = 'So_blt' + call seq_flds_add(o2x_states,trim(name)) + call seq_flds_add(x2g_states,trim(name)) + call seq_flds_add(x2g_states_from_ocn,trim(name)) + longname = 'Ice shelf boundary layer ocean temperature' + stdname = 'Ice_shelf_boundary_layer_ocean_temperature' + units = 'C' + attname = 'So_blt' + call metadata_set(attname, longname, stdname, units) + + name = 'So_bls' + call seq_flds_add(o2x_states,trim(name)) + call seq_flds_add(x2g_states,trim(name)) + call seq_flds_add(x2g_states_from_ocn,trim(name)) + longname = 'Ice shelf boundary layer ocean salinity' + stdname = 'Ice_shelf_boundary_layer_ocean_salinity' + units = 'psu' + attname = 'So_bls' + call metadata_set(attname, longname, stdname, units) + + name = 'So_htv' + call seq_flds_add(o2x_states,trim(name)) + call seq_flds_add(x2g_states,trim(name)) + call seq_flds_add(x2g_states_from_ocn,trim(name)) + longname = 'Ice shelf ocean heat transfer velocity' + stdname = 'Ice_shelf_ocean_heat_transfer_velocity' + units = 'm/s' + attname = 'So_htv' + call metadata_set(attname, longname, stdname, units) + + name = 'So_stv' + call seq_flds_add(o2x_states,trim(name)) + call seq_flds_add(x2g_states,trim(name)) + call seq_flds_add(x2g_states_from_ocn,trim(name)) + longname = 'Ice shelf ocean salinity transfer velocity' + stdname = 'Ice_shelf_ocean_salinity_transfer_velocity' + units = 'm/s' + attname = 'So_stv' + call metadata_set(attname, longname, stdname, units) + + name = 'So_rhoeff' + call seq_flds_add(o2x_states,trim(name)) + call seq_flds_add(x2g_states,trim(name)) + call seq_flds_add(x2g_states_from_ocn,trim(name)) + longname = 'Ocean effective pressure' + stdname = 'Ocean_effective_pressure' + units = 'Pa' + attname = 'So_rhoeff' + call metadata_set(attname, longname, stdname, units) + + name = 'Fogx_qicelo' + call seq_flds_add(g2x_fluxes,trim(name)) + call seq_flds_add(x2o_fluxes,trim(name)) + longname = 'Subshelf liquid flux for ocean' + stdname = 'Subshelf_liquid_flux_for_ocean' + units = 'kg m-2 s-1' + attname = 'Fogx_qicelo' + call metadata_set(attname, longname, stdname, units) + + name = 'Fogx_qiceho' + call seq_flds_add(g2x_fluxes,trim(name)) + call seq_flds_add(x2o_fluxes,trim(name)) + longname = 'Subshelf heat flux for the ocean' + stdname = 'Subshelf_heat_flux_for_the_ocean' + units = 'W m-2' + attname = 'Fogx_qiceho' + call metadata_set(attname, longname, stdname, units) + + name = 'Sg_blit' + call seq_flds_add(g2x_states,trim(name)) + call seq_flds_add(x2o_states,trim(name)) + longname = 'Boundary layer interface temperature for ocean' + stdname = 'Boundary_layer_interface_temperature_for_ocean' + units = 'C' + attname = 'Sg_blit' + call metadata_set(attname, longname, stdname, units) + + name = 'Sg_blis' + call seq_flds_add(g2x_states,trim(name)) + call seq_flds_add(x2o_states,trim(name)) + longname = 'Boundary layer interface salinity for ocean' + stdname = 'Boundary_layer_interface_salinity_for_ocean' + units = 'psu' + attname = 'Sg_blis' + call metadata_set(attname, longname, stdname, units) + + name = 'Sg_lithop' + call seq_flds_add(g2x_states,trim(name)) + call seq_flds_add(x2o_states,trim(name)) + longname = 'Ice sheet lithostatic pressure' + stdname = 'Ice_sheet_lithostatic_pressure' + units = 'Pa' + attname = 'Sg_lithop' + call metadata_set(attname, longname, stdname, units) + + name = 'Sg_icemask_grounded' + call seq_flds_add(g2x_states,trim(name)) + call seq_flds_add(x2o_states,trim(name)) + longname = 'Grounded ice mask' + stdname = 'Grounded_ice_mask' + units = 'unitless' + attname = 'Sg_icemask_grounded' + call metadata_set(attname, longname, stdname, units) + + name = 'Sg_icemask_floating' + call seq_flds_add(g2x_states,trim(name)) + call seq_flds_add(x2o_states,trim(name)) + longname = 'Floating ice mask' + stdname = 'Floating_ice_mask' + units = 'unitless' + attname = 'Sg_icemask_floating' + call metadata_set(attname, longname, stdname, units) + + name = 'Sg_tbot' + call seq_flds_add(g2x_states,trim(name)) + call seq_flds_add(x2o_states,trim(name)) + longname = 'Bottom layer ice temperature' + stdname = 'Bottom_layer_ice_temperature' + units = 'C' + attname = 'Sg_tbot' + call metadata_set(attname, longname, stdname, units) + + name = 'Sg_dztbot' + call seq_flds_add(g2x_states,trim(name)) + call seq_flds_add(x2o_states,trim(name)) + longname = 'Bottom layer ice layer half thickness' + stdname = 'Bottom_layer_ice_layer_half_thickness' + units = 'm' + attname = 'Sg_dztbot' + call metadata_set(attname, longname, stdname, units) + + name = 'Fogx_qiceli' + call seq_flds_add(x2g_fluxes,trim(name)) + longname = 'Subshelf mass flux for ice sheet' + stdname = 'Subshelf_mass_flux_for_ice_sheet' + units = 'kg m-2 s-1' + attname = 'Fogx_qiceli' + call metadata_set(attname, longname, stdname, units) + + name = 'Fogx_qicehi' + call seq_flds_add(x2g_fluxes,trim(name)) + longname = 'Subshelf heat flux for ice sheet' + stdname = 'Subshelf_heat_flux_for_ice_sheet' + units = 'W m-2' + attname = 'Fogx_qicehi' + call metadata_set(attname, longname, stdname, units) + endif + ! Done glc fields if (flds_co2a) then @@ -3224,6 +3384,8 @@ subroutine seq_flds_set(nmlfile, ID, infodata) seq_flds_g2x_states = trim(g2x_states) seq_flds_g2x_states_to_lnd = trim(g2x_states_to_lnd) seq_flds_x2g_states = trim(x2g_states) + seq_flds_x2g_states_from_lnd = trim(x2g_states_from_lnd) + seq_flds_x2g_states_from_ocn = trim(x2g_states_from_ocn) seq_flds_xao_states = trim(xao_states) seq_flds_xao_albedo = trim(xao_albedo) seq_flds_xao_diurnl = trim(xao_diurnl) @@ -3248,6 +3410,7 @@ subroutine seq_flds_set(nmlfile, ID, infodata) seq_flds_g2o_liq_fluxes = trim(g2o_liq_fluxes) seq_flds_g2o_ice_fluxes = trim(g2o_ice_fluxes) seq_flds_x2g_fluxes = trim(x2g_fluxes) + seq_flds_x2g_fluxes_from_lnd = trim(x2g_fluxes_from_lnd) seq_flds_xao_fluxes = trim(xao_fluxes) seq_flds_r2x_fluxes = trim(r2x_fluxes) seq_flds_x2r_fluxes = trim(x2r_fluxes) diff --git a/src/drivers/mct/shr/seq_infodata_mod.F90 b/src/drivers/mct/shr/seq_infodata_mod.F90 index 12644e25870..751ca3639aa 100644 --- a/src/drivers/mct/shr/seq_infodata_mod.F90 +++ b/src/drivers/mct/shr/seq_infodata_mod.F90 @@ -186,6 +186,7 @@ MODULE seq_infodata_mod logical :: ocn_present ! does component model exist logical :: ocn_prognostic ! does component model need input data from driver logical :: ocnrof_prognostic ! does component need rof data + logical :: ocn_c2_glcshelf ! will ocn component send data for ice shelf fluxes in driver logical :: ice_present ! does component model exist logical :: ice_prognostic ! does component model need input data from driver logical :: iceberg_prognostic ! does the ice model support icebergs @@ -719,6 +720,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%rof_prognostic = .false. infodata%ocn_prognostic = .false. infodata%ocnrof_prognostic = .false. + infodata%ocn_c2_glcshelf = .false. infodata%ice_prognostic = .false. infodata%glc_prognostic = .false. ! It's safest to assume glc_coupled_fluxes = .true. if it's not set elsewhere, @@ -946,9 +948,12 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ start_type, restart_pfile, restart_file, perpetual, perpetual_ymd, & aqua_planet,aqua_planet_sst, brnch_retain_casename, & single_column, scmlat,scmlon,logFilePostFix, outPathRoot, & - atm_present, atm_prognostic, lnd_present, lnd_prognostic, rof_prognostic, & - rof_present, ocn_present, ocn_prognostic, ocnrof_prognostic, & - ice_present, ice_prognostic, glc_present, glc_prognostic, & + atm_present, atm_prognostic, & + lnd_present, lnd_prognostic, & + rof_present, rof_prognostic, & + ocn_present, ocn_prognostic, ocnrof_prognostic, ocn_c2_glcshelf, & + ice_present, ice_prognostic, & + glc_present, glc_prognostic, & iac_present, iac_prognostic, & glc_coupled_fluxes, & flood_present, wav_present, wav_prognostic, rofice_present, & @@ -1109,6 +1114,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(OUT) :: ocn_present logical, optional, intent(OUT) :: ocn_prognostic logical, optional, intent(OUT) :: ocnrof_prognostic + logical, optional, intent(OUT) :: ocn_c2_glcshelf logical, optional, intent(OUT) :: ice_present logical, optional, intent(OUT) :: ice_prognostic logical, optional, intent(OUT) :: iceberg_prognostic @@ -1284,6 +1290,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(ocn_present) ) ocn_present = infodata%ocn_present if ( present(ocn_prognostic) ) ocn_prognostic = infodata%ocn_prognostic if ( present(ocnrof_prognostic) ) ocnrof_prognostic = infodata%ocnrof_prognostic + if ( present(ocn_c2_glcshelf) ) ocn_c2_glcshelf = infodata%ocn_c2_glcshelf if ( present(ice_present) ) ice_present = infodata%ice_present if ( present(ice_prognostic) ) ice_prognostic = infodata%ice_prognostic if ( present(iceberg_prognostic)) iceberg_prognostic = infodata%iceberg_prognostic @@ -1472,9 +1479,12 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ start_type, restart_pfile, restart_file, perpetual, perpetual_ymd, & aqua_planet,aqua_planet_sst, brnch_retain_casename, & single_column, scmlat,scmlon,logFilePostFix, outPathRoot, & - atm_present, atm_prognostic, lnd_present, lnd_prognostic, rof_prognostic, & - rof_present, ocn_present, ocn_prognostic, ocnrof_prognostic, & - ice_present, ice_prognostic, glc_present, glc_prognostic, & + atm_present, atm_prognostic, & + lnd_present, lnd_prognostic, & + rof_present, rof_prognostic, & + ocn_present, ocn_prognostic, ocnrof_prognostic, ocn_c2_glcshelf, & + ice_present, ice_prognostic, & + glc_present, glc_prognostic, & glc_coupled_fluxes, & flood_present, wav_present, wav_prognostic, rofice_present, & glclnd_present, glcocn_present, glcice_present, iceberg_prognostic,& @@ -1633,6 +1643,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(IN) :: ocn_present logical, optional, intent(IN) :: ocn_prognostic logical, optional, intent(IN) :: ocnrof_prognostic + logical, optional, intent(IN) :: ocn_c2_glcshelf logical, optional, intent(IN) :: ice_present logical, optional, intent(IN) :: ice_prognostic logical, optional, intent(IN) :: iceberg_prognostic @@ -1806,6 +1817,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(ocn_present) ) infodata%ocn_present = ocn_present if ( present(ocn_prognostic) ) infodata%ocn_prognostic = ocn_prognostic if ( present(ocnrof_prognostic)) infodata%ocnrof_prognostic = ocnrof_prognostic + if ( present(ocn_c2_glcshelf)) infodata%ocn_c2_glcshelf = ocn_c2_glcshelf if ( present(ice_present) ) infodata%ice_present = ice_present if ( present(ice_prognostic) ) infodata%ice_prognostic = ice_prognostic if ( present(iceberg_prognostic)) infodata%iceberg_prognostic = iceberg_prognostic @@ -2104,6 +2116,7 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%ocn_present, mpicom) call shr_mpi_bcast(infodata%ocn_prognostic, mpicom) call shr_mpi_bcast(infodata%ocnrof_prognostic, mpicom) + call shr_mpi_bcast(infodata%ocn_c2_glcshelf, mpicom) call shr_mpi_bcast(infodata%ice_present, mpicom) call shr_mpi_bcast(infodata%ice_prognostic, mpicom) call shr_mpi_bcast(infodata%iceberg_prognostic, mpicom) @@ -2387,6 +2400,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) call shr_mpi_bcast(infodata%ocn_present, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%ocn_prognostic, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%ocnrof_prognostic, mpicom, pebcast=cmppe) + call shr_mpi_bcast(infodata%ocn_c2_glcshelf, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%ocn_nx, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%ocn_ny, mpicom, pebcast=cmppe) ! dead_comps is true if it's ever set to true @@ -2461,6 +2475,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) call shr_mpi_bcast(infodata%ocn_present, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%ocn_prognostic, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%ocnrof_prognostic, mpicom, pebcast=cplpe) + call shr_mpi_bcast(infodata%ocn_c2_glcshelf, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%ice_present, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%ice_prognostic, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%iceberg_prognostic, mpicom, pebcast=cplpe) @@ -2801,6 +2816,7 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0L) subname,'ocn_present = ', infodata%ocn_present write(logunit,F0L) subname,'ocn_prognostic = ', infodata%ocn_prognostic write(logunit,F0L) subname,'ocnrof_prognostic = ', infodata%ocnrof_prognostic + write(logunit,F0L) subname,'ocn_c2_glcshelf = ', infodata%ocn_c2_glcshelf write(logunit,F0L) subname,'ice_present = ', infodata%ice_present write(logunit,F0L) subname,'ice_prognostic = ', infodata%ice_prognostic write(logunit,F0L) subname,'iceberg_prognostic = ', infodata%iceberg_prognostic diff --git a/src/share/util/shr_const_mod.F90 b/src/share/util/shr_const_mod.F90 index dd57395eb4c..bcc5be45b34 100644 --- a/src/share/util/shr_const_mod.F90 +++ b/src/share/util/shr_const_mod.F90 @@ -54,6 +54,17 @@ MODULE shr_const_mod real(R8),parameter :: SHR_CONST_LATVAP = 2.501e6_R8 ! latent heat of evaporation ~ J/kg real(R8),parameter :: SHR_CONST_LATSUB = & ! latent heat of sublimation ~ J/kg SHR_CONST_LATICE + SHR_CONST_LATVAP + real(R8),parameter :: SHR_CONST_CONDICE = 2.1_R8 ! thermal conductivity of ice ~ W/m/K + real(R8),parameter :: SHR_CONST_KAPPA_LAND_ICE = & ! Diffusivity of heat in land ice ~ + SHR_CONST_CONDICE / (SHR_CONST_RHOICE*SHR_CONST_CPICE) + real(R8),parameter :: SHR_CONST_TF0 = 6.22e-2_R8 ! The freezing temperature at zero pressure in + ! sub-ice-shelf ocean cavities ~ C + real(R8),parameter :: SHR_CONST_DTF_DP = -7.43e-8_R8 ! The coefficient for the term proportional to the (limited) + ! pressure in the freezing temperature in sub-ice-shelf ocean cavities. ~ C Pa^{-1} + real(R8),parameter :: SHR_CONST_DTF_DS = -5.63e-2_R8 !The coefficient for the term proportional to salinity in + ! the freezing temperature in sub-ice-ice ocean cavities ~ C PSU^{-1} + real(R8),parameter :: SHR_CONST_DTF_DPDS = -1.74e-10_R8 ! The coefficient for the term proportional to salinity times + ! pressure in the freezing temperature in sub-ice-shelf ocean cavities ~ C PSU^{-1} Pa^{-1} real(R8),parameter :: SHR_CONST_OCN_REF_SAL = 34.7_R8 ! ocn ref salinity (psu) real(R8),parameter :: SHR_CONST_ICE_REF_SAL = 4.0_R8 ! ice ref salinity (psu)