From 41276365db776abf6ac69d6d190da72e08478d93 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 31 Jan 2024 09:20:23 -0500 Subject: [PATCH 1/8] fix dummy arguments w/o values --- ufs/glc_elevclass_mod.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/ufs/glc_elevclass_mod.F90 b/ufs/glc_elevclass_mod.F90 index 6524f064f..626bb3ee0 100644 --- a/ufs/glc_elevclass_mod.F90 +++ b/ufs/glc_elevclass_mod.F90 @@ -37,6 +37,7 @@ subroutine glc_get_elevation_classes_without_bareland(glc_topo, glc_elevclass, l real(r8), intent(in) :: glc_topo(:) ! topographic height integer , intent(out) :: glc_elevclass(:) ! elevation class integer , intent(in) :: logunit + glc_elevclass = 0 end subroutine glc_get_elevation_classes_without_bareland !----------------------------------------------------------------------- @@ -45,6 +46,7 @@ subroutine glc_get_elevation_classes_with_bareland(glc_ice_covered, glc_topo, gl real(r8), intent(in) :: glc_topo(:) ! ice topographic height integer , intent(out) :: glc_elevclass(:) ! elevation class integer , intent(in) :: logunit + glc_elevclass = 0 end subroutine glc_get_elevation_classes_with_bareland !----------------------------------------------------------------------- @@ -57,11 +59,12 @@ end function glc_mean_elevation_virtual !----------------------------------------------------------------------- subroutine glc_get_fractional_icecov(nec, glc_topo, glc_icefrac, glc_icefrac_ec, logunit) - integer , intent(in) :: nec ! number of elevation classes + integer , intent(in) :: nec ! number of elevation classes real(r8), intent(in) :: glc_topo(:) ! topographic height real(r8), intent(in) :: glc_icefrac(:) real(r8), intent(out) :: glc_icefrac_ec(:,:) integer , intent(in) :: logunit + glc_icefrac_ec = 0.0_r8 end subroutine glc_get_fractional_icecov end module glc_elevclass_mod From 8cd4a32809a68102b38b4001fc9d55b31bf5c1c1 Mon Sep 17 00:00:00 2001 From: BinLi-NOAA Date: Thu, 1 Feb 2024 13:39:21 -0500 Subject: [PATCH 2/8] Update ccpp-physics in CMEPS to consider sea surface ocean current in air-sea flux computation (#107) * Update ufs/ccpp/data/MED_typedefs.meta. --- ufs/ccpp/data/MED_typedefs.F90 | 8 ++++++++ ufs/ccpp/data/MED_typedefs.meta | 20 ++++++++++++++++++++ 2 files changed, 28 insertions(+) diff --git a/ufs/ccpp/data/MED_typedefs.F90 b/ufs/ccpp/data/MED_typedefs.F90 index e7c84506e..786ce4711 100644 --- a/ufs/ccpp/data/MED_typedefs.F90 +++ b/ufs/ccpp/data/MED_typedefs.F90 @@ -173,6 +173,7 @@ module MED_typedefs integer :: lsm_noahmp !< flag for NOAH MP land surface model logical :: redrag !< flag for reduced drag coeff. over sea integer :: sfc_z0_type !< surface roughness options over water + integer :: icplocn2atm !< flag controlling whether to consider ocean current in air-sea flux calculation logical :: thsfc_loc !< flag for reference pressure in theta calculation integer :: nstf_name(5) !< NSSTM flag: off/uncoupled/coupled=0/1/2 integer :: lkm !< 0 = no lake model, 1 = lake model, 2 = lake & nsst on lake points @@ -249,6 +250,8 @@ module MED_typedefs real(kind=kind_phys), pointer :: fice(:) => null() !< ice fraction over open water real(kind=kind_phys), pointer :: hice(:) => null() !< sea ice thickness (m) real(kind=kind_phys), pointer :: tsfco(:) => null() !< sea surface temperature + real(kind=kind_phys), pointer :: usfco(:) => null() !< sea surface ocean current (zonal) + real(kind=kind_phys), pointer :: vsfco(:) => null() !< sea surface ocean current (merdional) real(kind=kind_phys), pointer :: uustar(:) => null() !< boundary layer parameter real(kind=kind_phys), pointer :: tsfc(:) => null() !< surface skin temperature real(kind=kind_phys), pointer :: snodi(:) => null() !< water equivalent snow depth over ice (mm) @@ -640,6 +643,7 @@ subroutine control_initialize(model) model%ivegsrc = 2 model%redrag = .false. model%sfc_z0_type = 0 + model%icplocn2atm = 0 model%thsfc_loc = .true. model%lsm = 1 model%lsm_noahmp = 2 @@ -739,6 +743,10 @@ subroutine sfcprop_create(sfcprop, im, model) sfcprop%hice = clear_val allocate(sfcprop%tsfco(im)) sfcprop%tsfco = clear_val + allocate(sfcprop%usfco(im)) + sfcprop%usfco = clear_val + allocate(sfcprop%vsfco(im)) + sfcprop%vsfco = clear_val allocate(sfcprop%uustar(im)) sfcprop%uustar = clear_val allocate(sfcprop%tsfc(im)) diff --git a/ufs/ccpp/data/MED_typedefs.meta b/ufs/ccpp/data/MED_typedefs.meta index 439a617a3..772358535 100644 --- a/ufs/ccpp/data/MED_typedefs.meta +++ b/ufs/ccpp/data/MED_typedefs.meta @@ -911,6 +911,12 @@ units = flag dimensions = () type = logical +[icplocn2atm] + standard_name = control_for_air_sea_flux_computation_over_water + long_name = air-sea flux option + units = 1 + dimensions = () + type = integer [kdt] standard_name = index_of_timestep long_name = current forecast iteration @@ -1156,6 +1162,20 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[usfco] + standard_name = x_ocean_current + long_name = zonal current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[vsfco] + standard_name = y_ocean_current + long_name = meridional current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys [uustar] standard_name = surface_friction_velocity long_name = boundary layer parameter From 624920ddbd819c76ec37591c24e872308201810e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ufuk=20Turun=C3=A7o=C4=9Flu?= Date: Mon, 5 Feb 2024 13:15:00 -0700 Subject: [PATCH 3/8] Update CMEPS (#110) Sync w/ ESCOMP, adding CDEPS inline capability to CMEPS --- .github/workflows/extbuild.yml | 16 +- .github/workflows/srt.yml | 20 +- cesm/driver/esmApp.F90 | 2 +- cesm/flux_atmocn/shr_flux_mod.F90 | 41 ++- cime_config/buildnml | 10 +- cime_config/config_component.xml | 35 +-- cime_config/namelist_definition_drv.xml | 31 +- cime_config/runseq/runseq_TG.py | 2 +- cime_config/testdefs/testlist_drv.xml | 106 +++---- mediator/esmFldsExchange_cesm_mod.F90 | 20 ++ mediator/esmFldsExchange_hafs_mod.F90 | 363 ++++++++++++++++-------- mediator/fd_cesm.yaml | 4 + mediator/med.F90 | 34 ++- mediator/med_internalstate_mod.F90 | 37 ++- mediator/med_map_mod.F90 | 257 ++++++++++++----- mediator/med_methods_mod.F90 | 67 +++++ mediator/med_phases_aofluxes_mod.F90 | 32 ++- mediator/med_phases_cdeps_mod.F90 | 292 +++++++++++++++++++ mediator/med_phases_ocnalb_mod.F90 | 2 +- mediator/med_phases_post_atm_mod.F90 | 2 + mediator/med_phases_prep_atm_mod.F90 | 1 + mediator/med_phases_prep_ocn_mod.F90 | 52 +++- mediator/med_phases_prep_wav_mod.F90 | 33 ++- 23 files changed, 1133 insertions(+), 326 deletions(-) create mode 100644 mediator/med_phases_cdeps_mod.F90 diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 6e26b40a5..0614d5acb 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -20,11 +20,11 @@ jobs: CPPFLAGS: "-I/usr/include -I/usr/local/include" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.4.2 + ESMF_VERSION: v8.6.0 PNETCDF_VERSION: checkpoint.1.12.3 - NETCDF_FORTRAN_VERSION: v4.6.0 - PIO_VERSION: pio2_6_0 - CDEPS_VERSION: cdeps1.0.15 + NETCDF_FORTRAN_VERSION: v4.6.1 + PIO_VERSION: pio2_6_2 + CDEPS_VERSION: cdeps1.0.26 steps: - uses: actions/checkout@v3 # Build the ESMF library, if the cache contains a previous build @@ -84,7 +84,7 @@ jobs: ref: ${{ env.CDEPS_VERSION }} - name: Build CDEPS if: steps.cache-cdeps.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildcdeps@cdeps1.0.15 + uses: ESCOMP/CDEPS/.github/actions/buildcdeps@cdeps1.0.26 with: esmfmkfile: $HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk pio_path: $HOME/pio @@ -102,6 +102,6 @@ jobs: make VERBOSE=1 popd - - name: Setup tmate session - if: ${{ failure() }} - uses: mxschmitt/action-tmate@v3 +# - name: Setup tmate session +# if: ${{ failure() }} +# uses: mxschmitt/action-tmate@v3 diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 34252cb63..1044661ba 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -26,8 +26,8 @@ jobs: CPPFLAGS: "-I/usr/include -I/usr/local/include " LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf -lnetcdff -lpnetcdf" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.5.0 - PARALLELIO_VERSION: pio2_6_0 + ESMF_VERSION: v8.6.0 + PARALLELIO_VERSION: pio2_6_2 CIME_MODEL: cesm CIME_DRIVER: nuopc GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} @@ -79,7 +79,21 @@ jobs: - name: checkout externals run: | pushd cesm - ./manage_externals/checkout_externals ccs_config cdeps cime share mct cpl7 parallelio + ./manage_externals/checkout_externals ccs_config cdeps share mct cpl7 parallelio + cd ccs_config + git checkout main + cd ../ + git clone https://github.com/ESMCI/cime + cd cime + if [[ ! -e "${PWD}/.gitmodules.bak" ]] + then + echo "Converting git@github.com to https://github.com urls in ${PWD}/.gitmodules" + + sed -i".bak" "s/git@github.com:/https:\/\/github.com\//g" "${PWD}/.gitmodules" + fi + git submodule update --init + cd ../components/cdeps + git checkout main - name: Cache ESMF id: cache-esmf diff --git a/cesm/driver/esmApp.F90 b/cesm/driver/esmApp.F90 index 12cf1537d..5215ea2aa 100644 --- a/cesm/driver/esmApp.F90 +++ b/cesm/driver/esmApp.F90 @@ -139,7 +139,7 @@ program esmApp ! Call Run for the ensemble driver !----------------------------------------------------------------------------- call ESMF_GridCompRun(ensemble_driver_comp, userRc=urc, rc=rc) - if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) diff --git a/cesm/flux_atmocn/shr_flux_mod.F90 b/cesm/flux_atmocn/shr_flux_mod.F90 index 9ec558737..58f7ae923 100644 --- a/cesm/flux_atmocn/shr_flux_mod.F90 +++ b/cesm/flux_atmocn/shr_flux_mod.F90 @@ -133,7 +133,7 @@ end subroutine shr_flux_adjust_constants ! Thomas Toniazzo (Bjerknes Centre, Bergen) ” !=============================================================================== SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & - & qbot ,s16O ,sHDO ,s18O ,rbot, & + & qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & & tbot ,us ,vs, pslv, & & ts ,mask , seq_flux_atmocn_minwind, & & sen ,lat ,lwup , & @@ -141,7 +141,10 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & & evap ,evap_16O, evap_HDO, evap_18O, & & taux ,tauy ,tref ,qref , & & ocn_surface_flux_scheme, & - & duu10n, ustar_sv ,re_sv ,ssq_sv, & + & add_gusts, & + & duu10n, & + & ugust_out, & + & ustar_sv ,re_sv ,ssq_sv, & & missval) ! !USES: @@ -156,11 +159,13 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & integer(IN),intent(in) :: nMax ! data vector length integer(IN),intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain integer(IN),intent(in) :: ocn_surface_flux_scheme + logical ,intent(in) :: add_gusts real(R8) ,intent(in) :: zbot (nMax) ! atm level height (m) real(R8) ,intent(in) :: ubot (nMax) ! atm u wind (m/s) real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) + real(R8) ,intent(in) :: rainc(nMax) ! atm precip for convective gustiness (kg/m^3) - RBN 24Nov2008/MDF 31Jan2022 real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) @@ -188,6 +193,7 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 + real(R8),intent(out) :: ugust_out(nMax) ! diag: gustiness addition to U10 (m/s) real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) @@ -257,12 +263,31 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & real(R8) :: tdiff(nMax) ! tbot - ts real(R8) :: vscl + real(R8) :: ugust ! function: gustiness as a function of convective rainfall. + real(R8) :: gprec ! convective rainfall argument for ugust qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) - cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps + + ! Large and Yeager 2009 + cdn(Umps) = 0.0027_R8 / min(33.0000_R8,Umps) + 0.000142_R8 + & + 0.0000764_R8 * min(33.0000_R8,Umps) - 3.14807e-13_r8 * min(33.0000_R8,Umps)**6 + ! Capped Large and Pond by wind + ! cdn(Umps) = 0.0027_R8 / min(30.0_R8,Umps) + 0.000142_R8 + 0.0000764_R8 * min(30.0_R8,Umps) + ! Capped Large and Pond by Cd + ! cdn(Umps) = min(0.0025_R8, (0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps )) + ! Large and Pond + ! cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps + psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) + ! Convective gustiness appropriate for input precipitation. + ! Following Regelsperger et al. (2000, J. Clim) + ! Ug = log(1.0+6.69R-0.476R^2) + ! Coefficients X by 8640 for mm/s (from cam) -> cm/day (for above forumla) + ugust(gprec) = log(1._R8+57801.6_r8*gprec-3.55332096e7_r8*(gprec**2)) + + !--- formats ---------------------------------------- character(*),parameter :: subName = '(flux_atmOcn) ' character(*),parameter :: F00 = "('(flux_atmOcn) ',4a)" @@ -317,7 +342,14 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & if (mask(n) /= 0) then !--- compute some needed quantities --- - vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) + if (add_gusts) then + vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) + ugust(min(rainc(n),6.94444e-4_r8)) ) + ugust_out(n) = ugust(min(rainc(n),6.94444e-4_r8)) + else + vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) + ugust_out(n) = 0.0_r8 + end if + if (use_coldair_outbreak_mod) then ! Cold Air Outbreak Modification: ! Increase windspeed for negative tbot-ts @@ -452,6 +484,7 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & tref (n) = spval ! 2m reference height temperature (K) qref (n) = spval ! 2m reference height humidity (kg/kg) duu10n(n) = spval ! 10m wind speed squared (m/s)^2 + ugust_out(n) = spval ! gustiness addition (m/s) if (present(ustar_sv)) ustar_sv(n) = spval if (present(re_sv )) re_sv (n) = spval diff --git a/cime_config/buildnml b/cime_config/buildnml index 32be8ead4..ff2553be7 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -15,6 +15,7 @@ from CIME.case import Case from CIME.nmlgen import NamelistGenerator from CIME.utils import expect from CIME.utils import get_model, get_time_in_seconds, get_timestamp +from CIME.namelist import literal_to_python_value from CIME.buildnml import create_namelist_infile, parse_input from CIME.XML.files import Files @@ -105,7 +106,8 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config["COMP_OCN"] = case.get_value("COMP_OCN") config["COMP_ROF"] = case.get_value("COMP_ROF") config["COMP_WAV"] = case.get_value("COMP_WAV") - + config["CAMDEV"] = "True" if "CAM%DEV" in case.get_value("COMPSET") else "False" + if ( ( case.get_value("COMP_ROF") == "mosart" @@ -144,6 +146,11 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): if config["COMP_OCN"] == "docn" and "aqua" in case.get_value("DOCN_MODE"): nmlgen.set_value("aqua_planet", value=".true.") + # make sure that variable add_gusts is only set to true if compset includes cam_dev + add_gusts = literal_to_python_value(nmlgen.get_value("add_gusts"), type_="logical") + if add_gusts: + expect("CAM%DEV" in case.get_value("COMPSET"),"ERROR: add_gusts can only be set if CAM%DEV in compset {}".format(case.get_value("COMPSET"))) + # -------------------------------- # Overwrite: set component coupling frequencies # -------------------------------- @@ -658,6 +665,7 @@ def buildnml(case, caseroot, component): create_namelist_infile(case, user_nl_file, namelist_infile, infile_text) infile = [namelist_infile] + # create the files nuopc.runconfig, nuopc.runseq, drv_in and drv_flds_in _create_drv_namelists(case, infile, confdir, nmlgen, files) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index a329be743..938e0e31c 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -534,6 +534,15 @@ List of job ids for most recent case.submit + + char + regular + regular,premium,economy + run_begin_stop_restart + env_run.xml + job priority for systems supporting this option + + @@ -812,15 +821,6 @@ different MPI ranks to different GPUs within the same compute node - - logical - TRUE,FALSE - FALSE - build_def - env_build.xml - TRUE implies that at least one of the components is built threaded (DO NOT EDIT) - - logical TRUE,FALSE @@ -1026,23 +1026,6 @@ this to work. - - char - ESMF_LOGKIND_SINGLE,ESMF_LOGKIND_MULTI,ESMF_LOGKIND_NONE - ESMF_LOGKIND_NONE - run_flags - env_run.xml - - Determines what ESMF log files (if any) are generated when - USE_ESMF_LIB is TRUE. - ESMF_LOGKIND_SINGLE: Use a single log file, combining messages from - all of the PETs. Not supported on some platforms. - ESMF_LOGKIND_MULTI: Use multiple log files -- one per PET. - ESMF_LOGKIND_NONE: Do not issue messages to a log file. - By default, no ESMF log files are generated. - - - char off,low,high,max diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index dec6868f1..3e4d6bf6b 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -18,24 +18,6 @@ - - char - cime_pes - PELAYOUT_attributes - - Determines what ESMF log files (if any) are generated when - USE_ESMF_LIB is TRUE. - ESMF_LOGKIND_SINGLE: Use a single log file, combining messages from - all of the PETs. Not supported on some platforms. - ESMF_LOGKIND_MULTI: Use multiple log files — one per PET. - ESMF_LOGKIND_NONE: Do not issue messages to a log file. - By default, no ESMF log files are generated. - - - $ESMF_LOGFILE_KIND - - - integer pio @@ -964,6 +946,19 @@ + + logical + control + MED_attributes + + add a wind gustiness factor + + + .true. + .false. + + + logical budget diff --git a/cime_config/runseq/runseq_TG.py b/cime_config/runseq/runseq_TG.py index c0bb4ab92..dea8aede5 100644 --- a/cime_config/runseq/runseq_TG.py +++ b/cime_config/runseq/runseq_TG.py @@ -34,7 +34,7 @@ def gen_runseq(case, coupling_times): runseq.add_action ("MED med_phases_post_lnd" , run_lnd) runseq.add_action ("MED med_phases_prep_glc" , med_to_glc) runseq.add_action ("MED -> GLC :remapMethod=redist" , med_to_glc) - runseq.add_action ("GLC" , run_glc) + runseq.add_action ("GLC" , run_glc and med_to_glc) runseq.add_action ("GLC -> MED :remapMethod=redist" , run_glc) runseq.add_action ("MED med_phases_history_write" , True) diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index 985bd6ce9..e17b2ffcf 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -5,36 +5,36 @@ - + - + - + - + - + - + - + - + @@ -46,18 +46,18 @@ - + - + - + - + @@ -69,18 +69,18 @@ - + - + - + - + @@ -92,27 +92,27 @@ - + - + - + - + - + - + @@ -124,27 +124,27 @@ - + - + - + - + - + - + @@ -156,9 +156,9 @@ - + - + @@ -170,24 +170,24 @@ - + - + - + - + - + @@ -200,36 +200,36 @@ - + - + - + - + - + - + - + - + @@ -241,18 +241,18 @@ - + - + - + - + @@ -263,18 +263,18 @@ - + - + - + - + @@ -282,9 +282,9 @@ - + - + diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index a2c4fe435..c7cee8d98 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -276,6 +276,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_from(compatm, 'Sa_shum') call addfld_from(compatm, 'Sa_ptem') call addfld_from(compatm, 'Sa_dens') + call addfld_from(compatm, 'Faxa_rainc') if (flds_wiso) then call addfld_from(compatm, 'Sa_shum_wiso') end if @@ -288,6 +289,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap_from(compatm, 'Sa_u' , compocn, mappatch, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_v' , compocn, mappatch, 'one', atm2ocn_map) end if + call addmap_from(compatm, 'Faxa_rainc', compocn, mapconsf, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_z' , compocn, mapbilnr, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_tbot', compocn, mapbilnr, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_pbot', compocn, mapbilnr, 'one', atm2ocn_map) @@ -1365,6 +1367,24 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if + ! --------------------------------------------------------------------- + ! to atm: unmerged ugust_out from ocn + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_aoflux('So_ugustOut') + call addfld_to(compatm, 'So_ugustOut') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'So_ugustOut', rc=rc)) then + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_ugustOut', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap_aoflux('So_ugustOut', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg_to(compatm , 'So_ugustOut', & + mrg_from=compmed, mrg_fld='So_ugustOut', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if + ! --------------------------------------------------------------------- ! to atm: surface snow depth from ice (needed for cam) ! to atm: mean ice volume per unit area from ice diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index 1f645524e..b545b9b1c 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -13,6 +13,7 @@ module esmFldsExchange_hafs_mod use med_internalstate_mod , only : compwav use med_internalstate_mod , only : ncomps use med_internalstate_mod , only : coupling_mode + use esmFlds , only : addfld_ocnalb => med_fldList_addfld_ocnalb !--------------------------------------------------------------------- ! This is a mediator specific routine that determines ALL possible @@ -133,7 +134,7 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return !===================================================================== - ! FIELDS TO MEDIATOR component (for fractions and atm/ocn flux calculation) + ! Mediator fields !===================================================================== !---------------------------------------------------------- @@ -146,6 +147,18 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) !---------------------------------------------------------- call addfld_to(compatm, 'So_ofrac') + !---------------------------------------------------------- + ! from med: ocean albedos (not sent to the ATM in UFS). + !---------------------------------------------------------- + if (trim(coupling_mode) == 'hafs.mom6') then + if (phase == 'advertise') then + call addfld_ocnalb('So_avsdr') + call addfld_ocnalb('So_avsdf') + call addfld_ocnalb('So_anidr') + call addfld_ocnalb('So_anidf') + end if + end if + !===================================================================== ! FIELDS TO ATMOSPHERE !===================================================================== @@ -154,28 +167,41 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) ! to atm: surface temperatures from ocn ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then - allocate(S_flds(1)) - S_flds = (/'So_t'/) ! sea_surface_temperature - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - call addfld_from(compocn, trim(fldname)) - call addfld_to(compatm, trim(fldname)) - end do - deallocate(S_flds) + if (trim(coupling_mode) == 'hafs') then + allocate(S_flds(1)) + S_flds = (/'So_t'/) ! sea_surface_temperature + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld_from(compocn, trim(fldname)) + call addfld_to(compatm, trim(fldname)) + end do + deallocate(S_flds) + else + allocate(S_flds(3)) + S_flds = (/'So_t', & ! sea_surface_temperature + 'So_u', & ! surface zonal current + 'So_v'/) ! surface meridional current + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld_from(compocn, trim(fldname)) + call addfld_to(compatm, trim(fldname)) + end do + deallocate(S_flds) + end if end if ! --------------------------------------------------------------------- ! to atm: surface roughness length ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%wav_present) then - allocate(S_flds(1)) - S_flds = (/'Sw_z0'/) ! wave_z0_roughness_length - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - call addfld_from(compwav, trim(fldname)) - call addfld_to(compatm, trim(fldname)) - end do - deallocate(S_flds) + allocate(S_flds(1)) + S_flds = (/'Sw_z0'/) ! wave_z0_roughness_length + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld_from(compwav, trim(fldname)) + call addfld_to(compatm, trim(fldname)) + end do + deallocate(S_flds) end if !===================================================================== @@ -186,40 +212,72 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) ! to ocn: state fields ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then - allocate(S_flds(6)) - S_flds = (/'Sa_u10m', & ! inst_zonal_wind_height10m - 'Sa_v10m', & ! inst_merid_wind_height10m - 'Sa_t2m ', & ! inst_temp_height2m - 'Sa_q2m ', & ! inst_spec_humid_height2m - 'Sa_pslv', & ! inst_pres_height_surface - 'Sa_tskn' /) ! inst_temp_height_surface - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - call addfld_from(compatm, trim(fldname)) - call addfld_to(compocn, trim(fldname)) - end do - deallocate(S_flds) + if (trim(coupling_mode) == 'hafs') then + allocate(S_flds(6)) + S_flds = (/'Sa_u10m', & ! inst_zonal_wind_height10m + 'Sa_v10m', & ! inst_merid_wind_height10m + 'Sa_t2m ', & ! inst_temp_height2m + 'Sa_q2m ', & ! inst_spec_humid_height2m + 'Sa_pslv', & ! inst_pres_height_surface + 'Sa_tskn' /) ! inst_temp_height_surface + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld_from(compatm, trim(fldname)) + call addfld_to(compocn, trim(fldname)) + end do + deallocate(S_flds) + else + allocate(S_flds(1)) + S_flds = (/'Sa_pslv'/) ! inst_pres_height_surface + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld_from(compatm, trim(fldname)) + call addfld_to(compocn, trim(fldname)) + end do + deallocate(S_flds) + end if end if ! --------------------------------------------------------------------- ! to ocn: flux fields ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then - allocate(F_flds(7,2)) - F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! mean_zonal_moment_flx_atm - F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! mean_merid_moment_flx_atm - F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate - F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! mean_net_sw_flx - F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! mean_net_lw_flx - F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! mean_sensi_heat_flx - F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! mean_laten_heat_flx - do n = 1,size(F_flds,1) - fldname1 = trim(F_flds(n,1)) - fldname2 = trim(F_flds(n,2)) - call addfld_from(compatm, trim(fldname1)) - call addfld_to(compocn, trim(fldname2)) - end do - deallocate(F_flds) + if (trim(coupling_mode) == 'hafs') then + allocate(F_flds(7,2)) + F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! inst_zonal_moment_flx_atm + F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! inst_merid_moment_flx_atm + F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! inst_prec_rate + F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! inst_net_sw_flx + F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! inst_net_lw_flx + F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! inst_sensi_heat_flx + F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! inst_laten_heat_flx + do n = 1,size(F_flds,1) + fldname1 = trim(F_flds(n,1)) + fldname2 = trim(F_flds(n,2)) + call addfld_from(compatm, trim(fldname1)) + call addfld_to(compocn, trim(fldname2)) + end do + deallocate(F_flds) + else + allocate(F_flds(10,2)) + F_flds(1 ,:) = (/'Faxa_taux ','Foxx_taux '/) ! inst_zonal_moment_flx_atm + F_flds(2 ,:) = (/'Faxa_tauy ','Foxx_tauy '/) ! inst_merid_moment_flx_atm + F_flds(3 ,:) = (/'Faxa_rain ','Faxa_rain '/) ! inst_prec_rate + F_flds(4 ,:) = (/'Faxa_lwnet ','Foxx_lwnet '/) ! inst_net_lw_flx + F_flds(5 ,:) = (/'Faxa_sen ','Foxx_sen '/) ! inst_sensi_heat_flx + F_flds(6 ,:) = (/'Faxa_evap ','Foxx_evap '/) ! inst_evap_rate + F_flds(7 ,:) = (/'Faxa_swndr ','Foxx_swnet_idr'/) ! inst_down_sw_ir_dir_flx + F_flds(8 ,:) = (/'Faxa_swndf ','Foxx_swnet_idf'/) ! inst_down_sw_ir_dif_flx + F_flds(9 ,:) = (/'Faxa_swvdr ','Foxx_swnet_vdr'/) ! inst_down_sw_vis_dir_flx + F_flds(10,:) = (/'Faxa_swvdf ','Foxx_swnet_vdf'/) ! inst_down_sw_vis_dif_flx + do n = 1,size(F_flds,1) + fldname1 = trim(F_flds(n,1)) + fldname2 = trim(F_flds(n,2)) + call addfld_from(compatm, trim(fldname1)) + call addfld_to(compocn, trim(fldname2)) + end do + deallocate(F_flds) + end if end if !===================================================================== @@ -230,14 +288,14 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) ! to wav: 10-m wind components ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%wav_present) then - allocate(S_flds(2)) - S_flds = (/'Sa_u10m', 'Sa_v10m'/) - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - call addfld_from(compatm, trim(fldname)) - call addfld_to(compwav, trim(fldname)) - end do - deallocate(S_flds) + allocate(S_flds(2)) + S_flds = (/'Sa_u10m', 'Sa_v10m'/) + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + call addfld_from(compatm, trim(fldname)) + call addfld_to(compwav, trim(fldname)) + end do + deallocate(S_flds) end if call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -356,40 +414,59 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) ! to atm: sea surface temperature ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then - allocate(S_flds(1)) - S_flds = (/'So_t'/) ! sea_surface_temperature - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compocn,compocn),trim(fldname),rc=rc) & - ) then - call addmap_from(compocn, trim(fldname), compatm, & - mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%ocn2atm_smap) - call addmrg_to(compatm, trim(fldname), & - mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') - end if - end do - deallocate(S_flds) + if (trim(coupling_mode) == 'hafs') then + allocate(S_flds(1)) + S_flds = (/'So_t'/) ! sea_surface_temperature + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn),trim(fldname),rc=rc) & + ) then + call addmap_from(compocn, trim(fldname), compatm, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%ocn2atm_smap) + call addmrg_to(compatm, trim(fldname), & + mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + end if + end do + deallocate(S_flds) + else + allocate(S_flds(3)) + S_flds = (/'So_t', & ! sea_surface_temperature + 'So_u', & ! surface zonal current + 'So_v'/) ! surface meridional current + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn),trim(fldname),rc=rc) & + ) then + call addmap_from(compocn, trim(fldname), compatm, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%ocn2atm_smap) + call addmrg_to(compatm, trim(fldname), & + mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + end if + end do + deallocate(S_flds) + end if end if ! --------------------------------------------------------------------- ! to atm: surface roughness length ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%wav_present) then - allocate(S_flds(1)) - S_flds = (/'Sw_z0'/) ! wave_z0_roughness_length - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav,compwav),trim(fldname),rc=rc) & - ) then - call addmap_from(compwav, trim(fldname), compatm, & - mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%wav2atm_smap) - call addmrg_to(compatm, trim(fldname), & - mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') - end if - end do - deallocate(S_flds) + allocate(S_flds(1)) + S_flds = (/'Sw_z0'/) ! wave_z0_roughness_length + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compatm),trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav,compwav),trim(fldname),rc=rc) & + ) then + call addmap_from(compwav, trim(fldname), compatm, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%wav2atm_smap) + call addmrg_to(compatm, trim(fldname), & + mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') + end if + end do + deallocate(S_flds) end if !===================================================================== @@ -400,52 +477,96 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) ! to ocn: state fields ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then - allocate(S_flds(6)) - S_flds = (/'Sa_u10m', & ! inst_zonal_wind_height10m - 'Sa_v10m', & ! inst_merid_wind_height10m - 'Sa_t2m ', & ! inst_temp_height2m - 'Sa_q2m ', & ! inst_spec_humid_height2m - 'Sa_pslv', & ! inst_pres_height_surface - 'Sa_tskn' /) ! inst_temp_height_surface - do n = 1,size(S_flds) - fldname = trim(S_flds(n)) - if (fldchk(is_local%wrap%FBExp(compocn),trim(fldname),rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm),trim(fldname),rc=rc) & - ) then - call addmap_from(compatm, trim(fldname), compocn, & - mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) - call addmrg_to(compocn, trim(fldname), & - mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') - end if - end do - deallocate(S_flds) + if (trim(coupling_mode) == 'hafs') then + allocate(S_flds(6)) + S_flds = (/'Sa_u10m', & ! inst_zonal_wind_height10m + 'Sa_v10m', & ! inst_merid_wind_height10m + 'Sa_t2m ', & ! inst_temp_height2m + 'Sa_q2m ', & ! inst_spec_humid_height2m + 'Sa_pslv', & ! inst_pres_height_surface + 'Sa_tskn' /) ! inst_temp_height_surface + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compocn),trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm),trim(fldname),rc=rc) & + ) then + call addmap_from(compatm, trim(fldname), compocn, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) + call addmrg_to(compocn, trim(fldname), & + mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + end if + end do + deallocate(S_flds) + else + allocate(S_flds(1)) + S_flds = (/'Sa_pslv'/) ! inst_pres_height_surface + do n = 1,size(S_flds) + fldname = trim(S_flds(n)) + if (fldchk(is_local%wrap%FBExp(compocn),trim(fldname),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm),trim(fldname),rc=rc) & + ) then + call addmap_from(compatm, trim(fldname), compocn, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) + call addmrg_to(compocn, trim(fldname), & + mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + end if + end do + deallocate(S_flds) + end if end if ! --------------------------------------------------------------------- ! to ocn: flux fields ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%ocn_present) then - allocate(F_flds(7,2)) - F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! mean_zonal_moment_flx_atm - F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! mean_merid_moment_flx_atm - F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! mean_prec_rate - F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! mean_net_sw_flx - F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! mean_net_lw_flx - F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! mean_sensi_heat_flx - F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! mean_laten_heat_flx - do n = 1,size(F_flds,1) - fldname1 = trim(F_flds(n,1)) - fldname2 = trim(F_flds(n,2)) - if (fldchk(is_local%wrap%FBExp(compocn),trim(fldname2),rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm),trim(fldname1),rc=rc) & - ) then - call addmap_from(compatm, trim(fldname1), compocn, & - mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) - call addmrg_to(compocn, trim(fldname2), & - mrg_from=compatm, mrg_fld=trim(fldname1), mrg_type='copy') - end if - end do - deallocate(F_flds) + if (trim(coupling_mode) == 'hafs') then + allocate(F_flds(7,2)) + F_flds(1,:) = (/'Faxa_taux ','Faxa_taux '/) ! inst_zonal_moment_flx_atm + F_flds(2,:) = (/'Faxa_tauy ','Faxa_tauy '/) ! inst_merid_moment_flx_atm + F_flds(3,:) = (/'Faxa_rain ','Faxa_rain '/) ! inst_prec_rate + F_flds(4,:) = (/'Faxa_swnet','Faxa_swnet'/) ! inst_net_sw_flx + F_flds(5,:) = (/'Faxa_lwnet','Faxa_lwnet'/) ! inst_net_lw_flx + F_flds(6,:) = (/'Faxa_sen ','Faxa_sen '/) ! inst_sensi_heat_flx + F_flds(7,:) = (/'Faxa_lat ','Faxa_lat '/) ! inst_laten_heat_flx + do n = 1,size(F_flds,1) + fldname1 = trim(F_flds(n,1)) + fldname2 = trim(F_flds(n,2)) + if (fldchk(is_local%wrap%FBExp(compocn),trim(fldname2),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm),trim(fldname1),rc=rc) & + ) then + call addmap_from(compatm, trim(fldname1), compocn, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) + call addmrg_to(compocn, trim(fldname2), & + mrg_from=compatm, mrg_fld=trim(fldname1), mrg_type='copy') + end if + end do + deallocate(F_flds) + else + allocate(F_flds(10,2)) + F_flds(1 ,:) = (/'Faxa_taux ','Foxx_taux '/) ! inst_zonal_moment_flx_atm + F_flds(2 ,:) = (/'Faxa_tauy ','Foxx_tauy '/) ! inst_merid_moment_flx_atm + F_flds(3 ,:) = (/'Faxa_rain ','Faxa_rain '/) ! inst_prec_rate + F_flds(4 ,:) = (/'Faxa_lwnet ','Foxx_lwnet '/) ! inst_net_lw_flx + F_flds(5 ,:) = (/'Faxa_sen ','Foxx_sen '/) ! inst_sensi_heat_flx + F_flds(6 ,:) = (/'Faxa_evap ','Foxx_evap '/) ! inst_evap_rate + F_flds(7 ,:) = (/'Faxa_swndr ','Foxx_swnet_idr'/) ! inst_down_sw_ir_dir_flx + F_flds(8 ,:) = (/'Faxa_swndf ','Foxx_swnet_idf'/) ! inst_down_sw_ir_dif_flx + F_flds(9 ,:) = (/'Faxa_swvdr ','Foxx_swnet_vdr'/) ! inst_down_sw_vis_dir_flx + F_flds(10,:) = (/'Faxa_swvdf ','Foxx_swnet_vdf'/) ! inst_down_sw_vis_dif_flx + do n = 1,size(F_flds,1) + fldname1 = trim(F_flds(n,1)) + fldname2 = trim(F_flds(n,2)) + if (fldchk(is_local%wrap%FBExp(compocn),trim(fldname2),rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm),trim(fldname1),rc=rc) & + ) then + call addmap_from(compatm, trim(fldname1), compocn, & + mapfillv_bilnr, hafs_attr%mapnorm, hafs_attr%atm2ocn_smap) + call addmrg_to(compocn, trim(fldname2), & + mrg_from=compatm, mrg_fld=trim(fldname1), mrg_type='copy') + end if + end do + deallocate(F_flds) + end if end if !===================================================================== diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index c09a63c58..eaef1dc78 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -487,6 +487,10 @@ canonical_units: m description: atmosphere import # + - standard_name: So_ugustOut + canonical_units: m/s + description: atmosphere import + # #----------------------------------- # section: land-ice export # Note that the fields sent from glc->med do NOT have elevation classes, diff --git a/mediator/med.F90 b/mediator/med.F90 index 87bbb2fac..4a8d3d90b 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -123,6 +123,9 @@ subroutine SetServices(gcomp, rc) use med_diag_mod , only: med_phases_diag_ice_ice2med, med_phases_diag_ice_med2ice use med_fraction_mod , only: med_fraction_init, med_fraction_set use med_phases_profile_mod , only: med_phases_profile +#ifdef CDEPS_INLINE + use med_phases_cdeps_mod , only: med_phases_cdeps_run +#endif ! input/output variables type(ESMF_GridComp) :: gcomp @@ -505,6 +508,19 @@ subroutine SetServices(gcomp, rc) specPhaselabel="med_phases_diag_print", specRoutine=NUOPC_NoOp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return +#ifdef CDEPS_INLINE + !------------------ + ! phase routine for cdeps inline capabilty + !------------------ + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_cdeps_run"/), userRoutine=mediator_routine_Run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & + specPhaseLabel="med_phases_cdeps_run", specRoutine=med_phases_cdeps_run, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return +#endif + !------------------ ! attach specializing method(s) ! -> NUOPC specializes by default --->>> first need to remove the default @@ -934,6 +950,22 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) endif endif + ! Should target component use all data for first time step? + do ncomp = 1,ncomps + if (ncomp /= compmed) then + call NUOPC_CompAttributeGet(gcomp, name=trim(compname(ncomp))//"_use_data_first_import", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue, *) is_local%wrap%med_data_force_first(ncomp) + else + is_local%wrap%med_data_force_first(ncomp) = .false. + endif + if (maintask) then + write(logunit,*) trim(compname(ncomp))//'_use_data_first_import is ', is_local%wrap%med_data_force_first(ncomp) + endif + end if + end do + if (profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -1803,7 +1835,7 @@ subroutine DataInitialize(gcomp, rc) else if (trim(coupling_mode(1:3)) == 'ufs') then call esmFldsExchange_ufs(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode) == 'hafs') then + else if (coupling_mode(1:4) == 'hafs') then call esmFldsExchange_hafs(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index fbe4617cf..b06f20c1c 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -19,7 +19,7 @@ module med_internalstate_mod integer, public :: logunit ! logunit for mediator log output integer, public :: diagunit ! diagunit for budget output (med main only) - logical, public :: maintask=.false. ! is this the maintask + logical, public :: maintask = .false. ! is this the maintask integer, public :: med_id ! needed currently in med_io_mod and set in esm.F90 ! Components @@ -47,7 +47,7 @@ module med_internalstate_mod character(len=CS), public :: glc_name = '' ! Coupling mode - character(len=CS), public :: coupling_mode ! valid values are [cesm,ufs.nfrac,ufs.frac,ufs.nfrac.aoflux,ufs.frac.aoflux,hafs] + character(len=CS), public :: coupling_mode ! valid values are [cesm,ufs.nfrac,ufs.frac,ufs.nfrac.aoflux,ufs.frac.aoflux,hafs,hafs.mom6] ! Atmosphere-ocean flux algorithm character(len=CS), public :: aoflux_code ! valid values are [cesm,ccpp] @@ -119,10 +119,12 @@ module med_internalstate_mod type InternalStateStruct ! Present/allowed coupling/active coupling logical flags - logical, pointer :: comp_present(:) ! comp present flag - logical, pointer :: med_coupling_active(:,:) ! computes the active coupling - integer :: num_icesheets ! obtained from attribute - logical :: ocn2glc_coupling = .false. ! obtained from attribute + logical, pointer :: comp_present(:) ! comp present flag + logical, pointer :: med_coupling_active(:,:) ! computes the active coupling + logical, pointer :: med_data_active(:,:) ! uses stream data to provide background fill + logical, pointer :: med_data_force_first(:) ! force to use stream data for first coupling timestep + integer :: num_icesheets ! obtained from attribute + logical :: ocn2glc_coupling = .false. ! obtained from attribute logical :: lnd2glc_coupling = .false. logical :: accum_lnd2glc = .false. @@ -147,10 +149,10 @@ module med_internalstate_mod ! FBImp(n,n) = NState_Imp(n), copied in connector post phase ! FBImp(n,k) is the FBImp(n,n) interpolated to grid k ! Import/export States and field bundles (the field bundles have the scalar fields removed) - type(ESMF_State) , pointer :: NStateImp(:) ! Import data from various component, on their grid - type(ESMF_State) , pointer :: NStateExp(:) ! Export data to various component, on their grid - type(ESMF_FieldBundle) , pointer :: FBImp(:,:) ! Import data from various components interpolated to various grids - type(ESMF_FieldBundle) , pointer :: FBExp(:) ! Export data for various components, on their grid + type(ESMF_State) , pointer :: NStateImp(:) ! Import data from various component, on their grid + type(ESMF_State) , pointer :: NStateExp(:) ! Export data to various component, on their grid + type(ESMF_FieldBundle) , pointer :: FBImp(:,:) ! Import data from various components interpolated to various grids + type(ESMF_FieldBundle) , pointer :: FBExp(:) ! Export data for various components, on their grid ! Mediator field bundles for ocean albedo type(ESMF_FieldBundle) :: FBMed_ocnalb_o ! Ocn albedo on ocn grid @@ -173,6 +175,9 @@ module med_internalstate_mod ! Fractions type(ESMF_FieldBundle), pointer :: FBfrac(:) ! Fraction data for various components, on their grid + ! Data + type(ESMF_FieldBundle) , pointer :: FBData(:) ! Background data for various components, on their grid, provided by CDEPS inline + ! Accumulators for export field bundles type(ESMF_FieldBundle) :: FBExpAccumOcn ! Accumulator for Ocn export on Ocn grid integer :: ExpAccumOcnCnt = 0 ! Accumulator counter for FBExpAccumOcn @@ -303,6 +308,8 @@ subroutine med_internalstate_init(gcomp, rc) ! Allocate memory now that ncomps is determined allocate(is_local%wrap%med_coupling_active(ncomps,ncomps)) + allocate(is_local%wrap%med_data_active(ncomps,ncomps)) + allocate(is_local%wrap%med_data_force_first(ncomps)) allocate(is_local%wrap%nx(ncomps)) allocate(is_local%wrap%ny(ncomps)) allocate(is_local%wrap%NStateImp(ncomps)) @@ -316,6 +323,7 @@ subroutine med_internalstate_init(gcomp, rc) allocate(is_local%wrap%packed_data(ncomps,ncomps,nmappers)) allocate(is_local%wrap%FBfrac(ncomps)) allocate(is_local%wrap%FBArea(ncomps)) + allocate(is_local%wrap%FBData(ncomps)) allocate(is_local%wrap%mesh_info(ncomps)) ! Determine component names @@ -364,6 +372,15 @@ subroutine med_internalstate_init(gcomp, rc) write(msgString,*) trim(subname)//': Mediator dststatus_print is ',dststatus_print call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + ! Initialize flag for background fill using data + is_local%wrap%med_data_active(:,:) = .false. + is_local%wrap%med_data_active(compocn,compatm) = .true. + is_local%wrap%med_data_active(compatm,compocn) = .true. + is_local%wrap%med_data_active(compatm,compwav) = .true. + + ! Initialize flag to force using data in first coupling time step + is_local%wrap%med_data_force_first(:) = .false. + end subroutine med_internalstate_init !===================================================================== diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 3428d2268..f77d4242e 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -414,7 +414,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, dstMaskValue = ispval_mask end if end if - if (trim(coupling_mode) == 'hafs') then + if (coupling_mode(1:4) == 'hafs') then if (n1 == compatm .and. n2 == compwav) then srcMaskValue = ispval_mask end if @@ -429,6 +429,9 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, polemethod = ESMF_POLEMETHOD_NONE ! todo: remove this when ESMF tripolar mapping fix is in place. endif end if + if (trim(coupling_mode) == 'hafs.mom6') then + polemethod = ESMF_POLEMETHOD_NONE + endif ! Create route handle if (mapindex == mapfcopy) then @@ -893,12 +896,14 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & if (npacked(mapindex) > 0) then ! Create the packed source field bundle for mapindex allocate(ptrsrc_packed(npacked(mapindex), lsize_src)) + ptrsrc_packed(npacked(mapindex),:) = 0._R8 packed_data(mapindex)%field_src = ESMF_FieldCreate(lmesh_src, & ptrsrc_packed, gridToFieldMap=(/2/), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Create the packed destination field bundle for mapindex allocate(ptrdst_packed(npacked(mapindex), lsize_dst)) + ptrdst_packed(npacked(mapindex),:) = 0._R8 packed_data(mapindex)%field_dst = ESMF_FieldCreate(lmesh_dst, & ptrdst_packed, gridToFieldMap=(/2/), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -919,7 +924,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & end subroutine med_map_packed_field_create !================================================================================ - subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_data, routehandles, rc) + subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_normOne, packed_data, routehandles, rc) ! ----------------------------------------------- ! Do regridding via packed field bundles @@ -929,33 +934,47 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet use ESMF , only : ESMF_FieldBundleIsCreated use ESMF , only : ESMF_FieldRedist, ESMF_RouteHandle + use ESMF , only : ESMF_FieldFill + use ESMF , only : ESMF_KIND_R8 + use ESMF , only : ESMF_Region_Flag, ESMF_REGION_SELECT, ESMF_REGION_TOTAL use med_internalstate_mod , only : nmappers, mapfcopy use med_internalstate_mod , only : mappatch_uv3d, mappatch, mapbilnr_uv3d, mapbilnr use med_internalstate_mod , only : packed_data_type + use med_methods_mod , only : Field_diagnose => med_methods_Field_diagnose ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FBSrc - type(ESMF_FieldBundle) , intent(inout) :: FBDst - type(ESMF_Field) , intent(in) :: field_normOne(:) ! array over mapping types - type(ESMF_FieldBundle) , intent(in) :: FBFracSrc ! fraction field bundle for source - type(packed_data_type) , intent(inout) :: packed_data(:) ! array over mapping types - type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) - integer , intent(out) :: rc + type(ESMF_FieldBundle) , intent(in) :: FBSrc + type(ESMF_FieldBundle) , intent(inout) :: FBDst + type(ESMF_Field) , intent(in) :: field_normOne(:) ! array over mapping types + type(ESMF_FieldBundle) , intent(in) :: FBFracSrc ! fraction field bundle for source + type(packed_data_type) , intent(inout) :: packed_data(:) ! array over mapping types + type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) + type(ESMF_FieldBundle), optional, intent(in) :: FBDat ! data field bundle + logical, optional , intent(in) :: use_data ! skip mapping and use data instead + integer, optional , intent(out) :: rc ! local variables - integer :: nf, nu, np, n - integer :: fieldcount - integer :: mapindex - integer :: ungriddedUBound(1) - real(r8), pointer :: dataptr1d(:) - real(r8), pointer :: dataptr2d(:,:) - real(r8), pointer :: dataptr2d_packed(:,:) - type(ESMF_Field) :: field_fracsrc - type(ESMF_Field), pointer :: fieldlist_src(:) - type(ESMF_Field), pointer :: fieldlist_dst(:) - real(r8), pointer :: data_norm(:) - real(r8), pointer :: data_dst(:,:) - character(len=*), parameter :: subname=' (med_map_mod:med_map_field_packed) ' + integer :: nf, nu, np, n, nfd + integer :: fieldcount, fieldcount_dat + integer :: mapindex + integer :: ungriddedUBound(1) + real(r8), pointer :: dataptr(:) + real(r8), pointer :: dataptr1d(:) + real(r8), pointer :: dataptr2d(:,:) + real(r8), pointer :: dataptr2d_packed(:,:) + type(ESMF_Field) :: field_fracsrc + type(ESMF_Field), pointer :: fieldlist_src(:) + type(ESMF_Field), pointer :: fieldlist_dst(:) + type(ESMF_Field), pointer :: fieldlist_dat(:) + real(r8), pointer :: data_norm(:) + real(r8), pointer :: data_dst(:,:) + character(cl) :: field_name + character(cl), allocatable :: field_namelist_dat(:) + logical :: isFound + logical :: skip_mapping + type(ESMF_Region_Flag) :: zeroregion + real(ESMF_KIND_R8), parameter :: fillValue = 9.99e20_ESMF_KIND_R8 + character(len=*), parameter :: subname=' (med_map_mod:med_map_field_packed) ' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -977,6 +996,22 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d fieldcount=0 endif + ! Get field count for FBDat if it is given and created + fieldcount_dat = 0 + skip_mapping = .false. + if (present(FBdat)) then + if (ESMF_FieldBundleIsCreated(FBdat)) then + call ESMF_FieldBundleGet(FBDat, fieldCount=fieldcount_dat, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + allocate(fieldlist_dat(fieldcount_dat)) + allocate(field_namelist_dat(fieldcount_dat)) + call ESMF_FieldBundleGet(FBDat, fieldlist=fieldlist_dat, fieldNameList=field_namelist_dat, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (present(use_data)) skip_mapping = use_data + end if + end if ! Loop over mapping types do mapindex = 1,nmappers @@ -1012,6 +1047,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d ! Get the indices into the packed data structure np = packed_data(mapindex)%fldindex(nf) if (np > 0) then + ! Fill packed source field call ESMF_FieldGet(fieldlist_src(nf), ungriddedUBound=ungriddedUBound, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (ungriddedUBound(1) > 0) then @@ -1027,8 +1063,90 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d end if end if end do + + ! Nullify pointers + nullify(dataptr2d_packed) + nullify(dataptr2d) + nullify(dataptr1d) + call t_stopf('MED:'//trim(subname)//' copy from src') + ! ----------------------------------- + ! Fill destination field with background data provided by CDEPS inline + ! ----------------------------------- + + if (fieldcount_dat > 0) then + ! First get the pointer for the packed destination data + call ESMF_FieldGet(packed_data(mapindex)%field_dst, farrayptr=dataptr2d_packed, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Loop over fields and fill it if there is a match + do nf = 1,fieldcount + ! Get the indices into the packed data structure + np = packed_data(mapindex)%fldindex(nf) + if (np > 0) then + ! Get size of ungridded dimension and name of the field + call ESMF_FieldGet(fieldlist_dst(nf), ungriddedUBound=ungriddedUBound, name=field_name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (maintask) write(logunit,'(a)') trim(subname)//" search "//trim(field_name)//" field for background fill." + + ! Check if field has match in data fields + isFound = .false. + do nfd = 1, fieldcount_dat + ! Debug output for checked fields to find match + if (maintask .and. dbug_flag > 1) write(logunit,'(a)') trim(field_name)//" - "//trim(field_namelist_dat(nfd)) + + if (trim(field_name) == trim(field_namelist_dat(nfd))) then + ! Debug output about match + if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_namelist_dat(nfd))//" is found!" + + ! Get pointer from data field + call ESMF_FieldGet(fieldlist_dat(nfd), farrayptr=dataptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 1) then + call Field_diagnose(packed_data(mapindex)%field_dst, trim(field_name), " --> before background fill: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! Fill destination field with background data coming from stream + dataptr2d_packed(np,:) = dataptr(:) + + if (dbug_flag > 1) then + call Field_diagnose(packed_data(mapindex)%field_dst, trim(field_name), " --> after background fill: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! Exit from loop since match is already found + isFound = .true. + exit + end if + end do ! loop for stream fields + + ! Could not find match in the list of stream fields + if (.not. isFound) then + if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_name)//" is not found!" + + ! Fill destination field with very large background data + dataptr2d_packed(np,:) = fillValue + end if + end if + end do ! loop for destination fields + + ! Set zeroregion option to select since we are blending data + zeroregion = ESMF_REGION_SELECT + else + ! Fill packed destination field/s with large value if data is unavailable + ! The data needs to be merged in the component side + ! This is also required for mapfillv_bilnr interpolation type + call ESMF_FieldFill(packed_data(mapindex)%field_dst, dataFillScheme="const", const1=fillValue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Set zeroregion option to total since we have no data to blend + zeroregion = ESMF_REGION_TOTAL + end if + ! ----------------------------------- ! Do the mapping ! ----------------------------------- @@ -1063,30 +1181,36 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d else if ( trim(packed_data(mapindex)%mapnorm) == 'one' .or. trim(packed_data(mapindex)%mapnorm) == 'none') then - ! Mapping with no normalization that is not redistribution - call med_map_field (& - field_src=packed_data(mapindex)%field_src, & - field_dst=packed_data(mapindex)%field_dst, & - routehandles=routehandles, & - maptype=mapindex, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Obtain unity normalization factor and multiply - ! interpolated field by reciprocal of normalization factor - if (trim(packed_data(mapindex)%mapnorm) == 'one') then - call ESMF_FieldGet(field_normOne(mapindex), farrayPtr=data_norm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(packed_data(mapindex)%field_dst, farrayPtr=data_dst, rc=rc) + ! Skip mapping if it is requested + if (skip_mapping) then + if (maintask) write(logunit,'(a)') trim(subname)//" skip mapping since use_data is set to .true." + else + ! Mapping with no normalization that is not redistribution + call med_map_field (& + field_src=packed_data(mapindex)%field_src, & + field_dst=packed_data(mapindex)%field_dst, & + routehandles=routehandles, & + maptype=mapindex, & + zeroregiontype=zeroregion, & + rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(data_dst,dim=2) - if (data_norm(n) == 0.0_r8) then - data_dst(:,n) = 0.0_r8 - else - data_dst(:,n) = data_dst(:,n)/data_norm(n) - end if - end do - end if + ! Obtain unity normalization factor and multiply + ! interpolated field by reciprocal of normalization factor + if (trim(packed_data(mapindex)%mapnorm) == 'one') then + call ESMF_FieldGet(field_normOne(mapindex), farrayPtr=data_norm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(packed_data(mapindex)%field_dst, farrayPtr=data_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(data_dst,dim=2) + if (data_norm(n) == 0.0_r8) then + data_dst(:,n) = 0.0_r8 + else + data_dst(:,n) = data_dst(:,n)/data_norm(n) + end if + end do + end if + end if end if call t_stopf('MED:'//trim(subname)//' map') @@ -1127,8 +1251,12 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d end do ! end of loop over mapindex if (ESMF_FieldBundleIsCreated(FBsrc)) then - deallocate(fieldlist_src) - deallocate(fieldlist_dst) + deallocate(fieldlist_src) + deallocate(fieldlist_dst) + end if + if (fieldcount_dat > 0) then + deallocate(fieldlist_dat) + deallocate(field_namelist_dat) end if call t_stopf('MED:'//subname) @@ -1250,7 +1378,7 @@ subroutine med_map_field_normalized(field_src, field_dst, routehandles, maptype, end subroutine med_map_field_normalized !================================================================================ - subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, rc) + subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, zeroregiontype, rc) !--------------------------------------------------- ! map the source field to the destination field @@ -1258,29 +1386,29 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_MAXSTR - use ESMF , only : ESMF_KIND_R8 use ESMF , only : ESMF_Field, ESMF_FieldRegrid - use ESMF , only : ESMF_FieldFill - use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_Region_Flag, ESMF_REGION_TOTAL - use ESMF , only : ESMF_REGION_SELECT + use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_Region_Flag + use ESMF , only : ESMF_REGION_TOTAL, ESMF_REGION_SELECT use ESMF , only : ESMF_RouteHandle + use ESMF , only : ESMF_FieldWriteVTK use med_internalstate_mod , only : mapnstod_consd, mapnstod_consf, mapnstod_consd, mapnstod use med_internalstate_mod , only : mapconsd, mapconsf use med_internalstate_mod , only : mapfillv_bilnr use med_methods_mod , only : Field_diagnose => med_methods_Field_diagnose ! input/output variables - type(ESMF_Field) , intent(in) :: field_src - type(ESMF_Field) , intent(inout) :: field_dst - type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) - integer , intent(in) :: maptype - character(len=*) , intent(in), optional :: fldname - integer , intent(out) :: rc + type(ESMF_Field) , intent(in) :: field_src + type(ESMF_Field) , intent(inout) :: field_dst + type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) + integer , intent(in) :: maptype + character(len=*), optional , intent(in) :: fldname + type(ESMF_Region_Flag), optional, intent(in) :: zeroregiontype + integer, optional , intent(out) :: rc ! local variables logical :: checkflag = .false. character(len=CS) :: lfldname - real(ESMF_KIND_R8), parameter :: fillValue = 9.99e20_ESMF_KIND_R8 + type(ESMF_Region_Flag) :: zeroregion character(len=*), parameter :: subname='(med_map_mod:med_map_field) ' !--------------------------------------------------- @@ -1292,9 +1420,12 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r lfldname = 'unknown' if (present(fldname)) lfldname = trim(fldname) + zeroregion = ESMF_REGION_TOTAL + if (present(zeroregiontype)) zeroregion = zeroregiontype + if (maptype == mapnstod_consd) then call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(mapnstod), & - termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=zeroregion, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then call Field_diagnose(field_dst, lfldname, " --> after nstod: ", rc=rc) @@ -1309,7 +1440,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r end if else if (maptype == mapnstod_consf) then call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(mapnstod), & - termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=zeroregion, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then call Field_diagnose(field_dst, lfldname, " --> after nstod: ", rc=rc) @@ -1323,12 +1454,6 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r if (chkerr(rc,__LINE__,u_FILE_u)) return end if else if (maptype == mapfillv_bilnr) then - call ESMF_FieldFill(field_dst, dataFillScheme="const", const1=fillValue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 1) then - call Field_diagnose(field_dst, lfldname, " --> after fillv: ", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if call ESMF_FieldRegrid(field_src, field_dst, routehandle=RouteHandles(mapfillv_bilnr), & termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_SELECT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 649c9c511..d4bdab2a7 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -44,6 +44,7 @@ module med_methods_mod public med_methods_FB_init_pointer public med_methods_FB_reset public med_methods_FB_diagnose + public med_methods_FB_write public med_methods_FB_FldChk public med_methods_FB_GetFldPtr public med_methods_FB_getNameN @@ -999,6 +1000,72 @@ subroutine med_methods_FB_diagnose(FB, string, rc) end subroutine med_methods_FB_diagnose !----------------------------------------------------------------------------- + + subroutine med_methods_FB_write(FB, string, rc) + ! ---------------------------------------------- + ! Diagnose status of FB + ! ---------------------------------------------- + + use ESMF, only : ESMF_FieldBundle, ESMF_FieldBundleGet + use ESMF, only : ESMF_Field, ESMF_FieldGet + use ESMF, only : ESMF_FieldWriteVTK + + type(ESMF_FieldBundle) , intent(inout) :: FB + character(len=*) , intent(in), optional :: string + integer , intent(out) :: rc + + ! local variables + integer :: n + integer :: fieldCount, lrank + character(ESMF_MAXSTR), pointer :: lfieldnamelist(:) + character(len=CL) :: lstring + type(ESMF_Field) :: lfield + character(len=*), parameter :: subname='(med_methods_FB_write)' + ! ---------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + rc = ESMF_SUCCESS + + lstring = '' + if (present(string)) then + lstring = trim(string) + endif + + ! Determine number of fields in field bundle and allocate memory for lfieldnamelist + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + + ! Get the fields in the field bundle + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! For each field in the bundle, get its memory location and print out the field + do n = 1, fieldCount + call ESMF_FieldBundleGet(FB, fieldName=trim(lfieldnamelist(n)), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(lfield, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 1) then + call ESMF_FieldWriteVTK(lfield, trim(lfieldnamelist(n))//'_'//trim(lstring), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + end do + + ! Deallocate memory + deallocate(lfieldnamelist) + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + + end subroutine med_methods_FB_write + + !----------------------------------------------------------------------------- #ifdef DIAGNOSE subroutine med_methods_Array_diagnose(array, string, rc) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 8c3d87c61..5252e6edc 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -78,6 +78,7 @@ module med_phases_aofluxes_mod logical :: compute_atm_dens logical :: compute_atm_thbot integer :: ocn_surface_flux_scheme ! use case + logical :: add_gusts character(len=CS), pointer :: fldnames_ocn_in(:) character(len=CS), pointer :: fldnames_atm_in(:) @@ -125,6 +126,7 @@ module med_phases_aofluxes_mod real(R8) , pointer :: shum_HDO (:) => null() ! atm HDO tracer real(R8) , pointer :: shum_18O (:) => null() ! atm H218O tracer real(R8) , pointer :: lwdn (:) => null() ! atm downward longwave heat flux + real(R8) , pointer :: rainc (:) => null() ! convective rain flux ! local size and computational mask and area: on aoflux grid integer :: lsize ! local size integer , pointer :: mask (:) => null() ! integer ocn domain mask: 0 <=> inactive cell @@ -146,6 +148,7 @@ module med_phases_aofluxes_mod real(R8) , pointer :: qref (:) => null() ! diagnostic: 2m ref Q real(R8) , pointer :: u10 (:) => null() ! diagnostic: 10m wind speed real(R8) , pointer :: duu10n (:) => null() ! diagnostic: 10m wind speed squared + real(R8) , pointer :: ugust_out (:) => null() ! diagnostic: gust wind added real(R8) , pointer :: ustar (:) => null() ! saved ustar real(R8) , pointer :: re (:) => null() ! saved re real(R8) , pointer :: ssq (:) => null() ! saved sq @@ -402,6 +405,14 @@ subroutine med_aofluxes_init(gcomp, aoflux_in, aoflux_out, rc) end if #endif + call NUOPC_CompAttributeGet(gcomp, name='add_gusts', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) add_gusts + else + add_gusts = .false. + end if + ! bottom level potential temperature and/or botom level density ! will need to be computed if not received from the atm if (FB_fldchk(is_local%Wrap%FBImp(Compatm,Compatm), 'Sa_ptem', rc=rc)) then @@ -1052,6 +1063,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) call flux_atmocn (logunit=logunit, & nMax=aoflux_in%lsize, & zbot=aoflux_in%zbot, ubot=aoflux_in%ubot, vbot=aoflux_in%vbot, thbot=aoflux_in%thbot, qbot=aoflux_in%shum, & + rainc=aoflux_in%rainc, & s16O=aoflux_in%shum_16O, sHDO=aoflux_in%shum_HDO, s18O=aoflux_in%shum_18O, rbot=aoflux_in%dens, & tbot=aoflux_in%tbot, us=aoflux_in%uocn, vs=aoflux_in%vocn, pslv=aoflux_in%psfc, ts=aoflux_in%tocn, & mask=aoflux_in%mask, seq_flux_atmocn_minwind=0.5_r8, & @@ -1060,7 +1072,10 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) evap=aoflux_out%evap, evap_16O=aoflux_out%evap_16O, evap_HDO=aoflux_out%evap_HDO, evap_18O=aoflux_out%evap_18O, & taux=aoflux_out%taux, tauy=aoflux_out%tauy, tref=aoflux_out%tref, qref=aoflux_out%qref, & ocn_surface_flux_scheme=ocn_surface_flux_scheme, & - duu10n=aoflux_out%duu10n, ustar_sv=aoflux_out%ustar, re_sv=aoflux_out%re, ssq_sv=aoflux_out%ssq, & + add_gusts=add_gusts, & + duu10n=aoflux_out%duu10n, & + ugust_out = aoflux_out%ugust_out, & + ustar_sv=aoflux_out%ustar, re_sv=aoflux_out%re, ssq_sv=aoflux_out%ssq, & missval=0.0_r8) #else @@ -1084,7 +1099,8 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) ocn_surface_flux_scheme=ocn_surface_flux_scheme, & sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evap=aoflux_out%evap, & taux=aoflux_out%taux, tauy=aoflux_out%tauy, tref=aoflux_out%tref, qref=aoflux_out%qref, & - duu10n=aoflux_out%duu10n, missval=0.0_r8) + duu10n=aoflux_out%duu10n, & + missval=0.0_r8) #ifdef UFS_AOFLUX end if #endif @@ -1581,6 +1597,10 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun_a, 'Sa_shum', aoflux_in%shum, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if (add_gusts) then + call fldbun_getfldptr(fldbun_a, 'Faxa_rainc', aoflux_in%rainc, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if end if ! extra fields for ufs.frac.aoflux @@ -1704,6 +1724,7 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun, 'Faox_lwup', aoflux_out%lwup, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if (flds_wiso) then call fldbun_getfldptr(fldbun, 'Faox_evap_16O', aoflux_out%evap_16O, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1717,6 +1738,13 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) allocate(aoflux_out%evap_HDO(lsize)); aoflux_out%evap_HDO(:) = 0._R8 end if + if (add_gusts) then + call fldbun_getfldptr(fldbun, 'So_ugustOut', aoflux_out%ugust_out, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + allocate(aoflux_out%ugust_out(lsize)); aoflux_out%ugust_out(:) = 0._R8 + end if + end subroutine set_aoflux_out_pointers !================================================================================ diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 new file mode 100644 index 000000000..72ac560cc --- /dev/null +++ b/mediator/med_phases_cdeps_mod.F90 @@ -0,0 +1,292 @@ +module med_phases_cdeps_mod + + use ESMF, only: ESMF_Clock, ESMF_ClockGet, ESMF_Time, ESMF_TimeGet + use ESMF, only: ESMF_Mesh + use ESMF, only: ESMF_GridComp, ESMF_GridCompGet + use ESMF, only: ESMF_LogWrite + use ESMF, only: ESMF_Field, ESMF_FieldGet + use ESMF, only: ESMF_FieldBundleGet, ESMF_FieldBundleIsCreated + use ESMF, only: ESMF_FieldBundleCreate + use ESMF, only: ESMF_GridCompGetInternalState + use ESMF, only: ESMF_SUCCESS, ESMF_LOGMSG_INFO + + use med_internalstate_mod, only: InternalState + use med_internalstate_mod, only: logunit, maintask + use med_internalstate_mod, only: ncomps, compname, compatm, compocn + use perf_mod , only: t_startf, t_stopf + use med_kind_mod , only: cl => shr_kind_cl + use med_kind_mod , only: r8 => shr_kind_r8 + use med_constants_mod , only: dbug_flag => med_constants_dbug_flag + use med_utils_mod , only: chkerr => med_utils_ChkErr + use med_methods_mod , only: FB_FldChk => med_methods_FB_FldChk + use med_methods_mod , only: FB_getFieldN => med_methods_FB_getFieldN + use med_methods_mod , only: FB_getNumflds => med_methods_FB_getNumflds + use med_methods_mod , only: FB_init => med_methods_FB_Init + use med_methods_mod , only: FB_diagnose => med_methods_FB_diagnose + use med_methods_mod , only: FB_write => med_methods_FB_write + use med_methods_mod , only: FB_GetFldPtr => med_methods_FB_GetFldPtr + + use dshr_mod , only: dshr_pio_init + use dshr_strdata_mod , only: shr_strdata_type + use dshr_strdata_mod , only: shr_strdata_init_from_inline + use dshr_strdata_mod , only: shr_strdata_advance + use dshr_stream_mod , only: shr_stream_init_from_esmfconfig + + implicit none + private + + !-------------------------------------------------------------------------- + ! Public interfaces + !-------------------------------------------------------------------------- + + public med_phases_cdeps_run + + !-------------------------------------------------------------------------- + ! Private data + !-------------------------------------------------------------------------- + + type config + integer :: year_first + integer :: year_last + integer :: year_align + integer :: offset + real(r8) :: dtlimit + character(len=cl) :: mesh_filename + character(len=cl), allocatable :: data_filename(:) + character(len=cl), allocatable :: fld_list(:) + character(len=cl), allocatable :: fld_list_model(:) + character(len=cl) :: mapalgo + character(len=cl) :: taxmode + character(len=cl) :: tintalgo + character(len=cl) :: name + end type config + + type(config) :: stream ! stream configuration + type(shr_strdata_type), allocatable :: sdat(:,:) ! input data stream + + character(*),parameter :: u_FILE_u = __FILE__ + +!============================================================================ +contains +!============================================================================ + + subroutine med_phases_cdeps_run(gcomp, rc) + + !------------------------------------------------------------------------ + ! Use CDEPS inline capability to read in data + !------------------------------------------------------------------------ + + use ESMF, only : ESMF_GridComp + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currTime + type(ESMF_Mesh) :: meshdst + type(ESMF_Field) :: flddst + integer :: i, j, k, l, nflds, streamid + integer :: n1, n2, item, nstreams, localPet + integer :: curr_ymd, sec + integer :: year, month, day, hour, minute, second + logical :: found + logical, save :: first_time = .true. + character(len=cl), allocatable :: fileList(:), varList(:,:) + character(len=cl) :: streamfilename, suffix, fldname + type(shr_strdata_type) :: sdat_config + character(len=*), parameter :: subname = '(med_phases_cdeps_run)' + !--------------------------------------- + + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + + ! Get the internal state from gcomp + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Query component + call ESMF_GridCompGet(gcomp, clock=clock, localPet=localPet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Initialize sdat streams + if (.not. allocated(sdat)) allocate(sdat(ncomps,ncomps)) + sdat(:,:)%mainproc = (localPet == 0) + + ! Initialize cdeps inline + if (first_time) then + ! Init PIO + call dshr_pio_init(gcomp, sdat_config, logunit, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Read stream configuration file + ! TODO: At this point it only suports ESMF config format (XML?) + streamfilename = 'stream.config' + call shr_stream_init_from_esmfconfig(streamfilename, sdat_config%stream, logunit, & + sdat_config%pio_subsystem, sdat_config%io_type, sdat_config%io_format, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Get number of streams + nstreams = size(sdat_config%stream) + + ! Loop over coupling directions and try to find field match in given streams + do n1 = 1, ncomps + do n2 = 1, ncomps + ! Check for coupling direction and background fill + if (n1 /= n2 .and. is_local%wrap%med_coupling_active(n1,n2) .and. is_local%wrap%med_data_active(n1,n2)) then + ! Get number of fields + call FB_getNumflds(is_local%wrap%FBImp(n1,n2), trim(subname), nflds, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Loop over fields and try to find it in the given stream + found = .false. + do i = 1, nflds + ! Query destination field + call FB_getFieldN(is_local%wrap%FBImp(n1,n2), i, flddst, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Query destination field name and its mesh + call ESMF_FieldGet(flddst, mesh=meshdst, name=fldname, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (maintask) write(logunit,'(a)') trim(subname)//": extracting destination mesh from "//trim(fldname) + + ! Check if any field in FB in the given stream + ! NOTE: Single stream could provide multiple fields !!! + streamid = 0 + do j = 1, nstreams + do k = 1, sdat_config%stream(j)%nvars + if (trim(sdat_config%stream(j)%varlist(k)%nameinmodel) == trim(fldname)) then + streamid = j + end if + end do + end do + + ! If match is found and previously not initialized, then initialize cdeps inline for the stream + if (size(sdat(n1,n2)%stream) == 0 .and. streamid /= 0) then + ! Debug print + if (maintask) then + write(logunit,'(a,i3)') trim(subname)//": initialize stream ", streamid + end if + + ! Allocate temporary variable to store file names in the stream + allocate(fileList(sdat_config%stream(streamid)%nfiles)) + allocate(varList(sdat_config%stream(streamid)%nvars,2)) + + ! Fill file abd variable lists with data + do l = 1, sdat_config%stream(streamid)%nfiles + fileList(l) = trim(sdat_config%stream(streamid)%file(l)%name) + if (maintask) write(logunit,'(a,i2,x,a)') trim(subname)//": file ", l, trim(fileList(l)) + end do + do l = 1, sdat_config%stream(streamid)%nvars + varList(l,1) = trim(sdat_config%stream(streamid)%varlist(l)%nameinfile) + varList(l,2) = trim(sdat_config%stream(streamid)%varlist(l)%nameinmodel) + if (maintask) write(logunit,'(a,i2,x,a)') trim(subname)//": variable ", l, trim(varList(l,1))//" -> "//trim(varList(l,2)) + end do + + ! Set PIO related variables + sdat(n1,n2)%pio_subsystem => sdat_config%pio_subsystem + sdat(n1,n2)%io_type = sdat_config%io_type + sdat(n1,n2)%io_format = sdat_config%io_format + + ! Init stream + call shr_strdata_init_from_inline(sdat(n1,n2), my_task=localPet, logunit=logunit, & + compname = 'cmeps', model_clock=clock, model_mesh=meshdst, & + stream_meshfile=trim(sdat_config%stream(streamid)%meshfile), & + stream_filenames=fileList, & + stream_yearFirst=sdat_config%stream(streamid)%yearFirst, & + stream_yearLast=sdat_config%stream(streamid)%yearLast, & + stream_yearAlign=sdat_config%stream(streamid)%yearAlign, & + stream_fldlistFile=varList(:,1), & + stream_fldListModel=varList(:,2), & + stream_lev_dimname=trim(sdat_config%stream(streamid)%lev_dimname), & + stream_mapalgo=trim(sdat_config%stream(streamid)%mapalgo), & + stream_offset=sdat_config%stream(streamid)%offset, & + stream_taxmode=trim(sdat_config%stream(streamid)%taxmode), & + stream_dtlimit=sdat_config%stream(streamid)%dtlimit, & + stream_tintalgo=trim(sdat_config%stream(streamid)%tInterpAlgo), & + stream_name=trim(compname(n1))//'_'//trim(compname(n2)), & + stream_src_mask=sdat_config%stream(streamid)%src_mask_val, & + stream_dst_mask=sdat_config%stream(streamid)%dst_mask_val, & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Print out source and destination mask used in the stream + if (maintask) write(logunit,'(a,2i2)') trim(subname)//": mask values src, dst ", & + sdat_config%stream(streamid)%src_mask_val, sdat_config%stream(streamid)%dst_mask_val + + ! Remove temporary variables + deallocate(fileList) + deallocate(varList) + + ! Set flag + found = .true. + end if + end do ! nflds + + ! Create empty FB + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBData(n2), rc=rc) .and. found) then + is_local%wrap%FBData(n2) = ESMF_FieldBundleCreate(name="inline_"//trim(compname(n2)), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + end if + end do ! n2 + end do ! n1 + + ! Set flag to false + first_time = .false. + end if + + ! Get current time + call ESMF_ClockGet(clock, currTime=currTime, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Query current time + call ESMF_TimeGet(currTime, yy=year, mm=month, dd=day, h=hour, m=minute, s=second, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + curr_ymd = abs(year)*10000+month*100+day + sec = hour*3600+minute*60+second + + ! Read data if stream initialized + do n1 = 1, ncomps + do n2 = 1, ncomps + if (size(sdat(n1,n2)%stream) > 0) then + ! Debug print + if (maintask) then + write(logunit,'(a)') trim(subname)//": read stream "//trim(compname(n1))//" -> "//trim(compname(n2)) + end if + + ! Read data + call shr_strdata_advance(sdat(n1,n2), ymd=curr_ymd, tod=sec, logunit=logunit, & + istr=trim(compname(n1))//'_'//trim(compname(n2)), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Check FB + call FB_diagnose(sdat(n1,n2)%pstrm(1)%fldbun_model, & + trim(subname)//':'//trim(compname(n1))//'_'//trim(compname(n2)), rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Point FB from internal one + is_local%wrap%FBData(n2) = sdat(n1,n2)%pstrm(1)%fldbun_model + + ! Write FB for debugging + if (dbug_flag > 10) then + write(suffix, fmt='(i4,a1,i2.2,a1,i2.2,a1,i5.5)') year, '-', month, '-', day, '-', sec + call FB_write(is_local%wrap%FBData(n2), suffix, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + end if + end do + end do + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + call t_stopf('MED:'//subname) + + end subroutine med_phases_cdeps_run + +end module med_phases_cdeps_mod diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 31bd211f0..304d0c7fd 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -242,7 +242,7 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) end if end if - write(msg,'(A,l)') trim(subname)//': use_nextswcday setting is ',use_nextswcday + write(msg,'(A,l1)') trim(subname)//': use_nextswcday setting is ',use_nextswcday call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) if (dbug_flag > 5) then diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index 9ed1b78d4..333497a69 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -65,6 +65,7 @@ subroutine med_phases_post_atm(gcomp, rc) FBSrc=is_local%wrap%FBImp(compatm,compatm), & FBDst=is_local%wrap%FBImp(compatm,compocn), & FBFracSrc=is_local%wrap%FBFrac(compatm), & + FBDat=is_local%wrap%FBData(compocn), & field_normOne=is_local%wrap%field_normOne(compatm,compocn,:), & packed_data=is_local%wrap%packed_data(compatm,compocn,:), & routehandles=is_local%wrap%RH(compatm,compocn,:), rc=rc) @@ -104,6 +105,7 @@ subroutine med_phases_post_atm(gcomp, rc) FBSrc=is_local%wrap%FBImp(compatm,compatm), & FBDst=is_local%wrap%FBImp(compatm,compwav), & FBFracSrc=is_local%wrap%FBFrac(compatm), & + FBDat=is_local%wrap%FBData(compwav), & field_normOne=is_local%wrap%field_normOne(compatm,compwav,:), & packed_data=is_local%wrap%packed_data(compatm,compwav,:), & routehandles=is_local%wrap%RH(compatm,compwav,:), rc=rc) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index abb6b7d5b..b9e7582e1 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -81,6 +81,7 @@ subroutine med_phases_prep_atm(gcomp, rc) FBSrc=is_local%wrap%FBImp(compocn,compocn), & FBDst=is_local%wrap%FBImp(compocn,compatm), & FBFracSrc=is_local%wrap%FBFrac(compocn), & + FBDat=is_local%wrap%FBData(compatm), & field_NormOne=is_local%wrap%field_normOne(compocn,compatm,:), & packed_data=is_local%wrap%packed_data(compocn,compatm,:), & routehandles=is_local%wrap%RH(compocn,compatm,:), rc=rc) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index d76f3e81a..d911d93e1 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -110,12 +110,40 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) rc = ESMF_SUCCESS call memcheck(subname, 5, maintask) - ! Get the internal state + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldList => med_fldList_GetfldListTo(compocn) - ! auto merges to ocn + + !--------------------------------------- + ! --- map atm to ocn, only if data stream is available + !--------------------------------------- + if (is_local%wrap%med_coupling_active(compatm,compocn) .and. & + is_local%wrap%med_data_active(compatm,compocn) .and. & + is_local%wrap%med_data_force_first(compocn)) then + call t_startf('MED:'//trim(subname)//' map_atm2ocn') + call med_map_field_packed( & + FBSrc=is_local%wrap%FBImp(compatm,compatm), & + FBDst=is_local%wrap%FBImp(compatm,compocn), & + FBFracSrc=is_local%wrap%FBFrac(compocn), & + FBDat=is_local%wrap%FBData(compocn), & + use_data=is_local%wrap%med_data_force_first(compocn), & + field_normOne=is_local%wrap%field_normOne(compatm,compocn,:), & + packed_data=is_local%wrap%packed_data(compatm,compocn,:), & + routehandles=is_local%wrap%RH(compatm,compocn,:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//trim(subname)//' map_atm2ocn') + + ! Reset flag to use data + is_local%wrap%med_data_force_first(compocn) = .false. + end if + + !--------------------------------------- + !--- merge all fields to ocn + !--------------------------------------- call med_merge_auto(& is_local%wrap%med_coupling_active(:,compocn), & is_local%wrap%FBExp(compocn), & @@ -125,6 +153,9 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + !--------------------------------------- + !--- custom calculations + !--------------------------------------- ! compute enthaly associated with rain, snow, condensation and liquid river runoff ! the sea-ice model already accounts for the enthalpy flux (as part of melth), so ! enthalpy from meltw **is not** included below @@ -438,11 +469,18 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc) end do ! Compute sw export to ocean bands if required if (export_swnet_by_bands) then - c1 = 0.285; c2 = 0.285; c3 = 0.215; c4 = 0.215 - Foxx_swnet_vdr(:) = c1 * Foxx_swnet(:) - Foxx_swnet_vdf(:) = c2 * Foxx_swnet(:) - Foxx_swnet_idr(:) = c3 * Foxx_swnet(:) - Foxx_swnet_idf(:) = c4 * Foxx_swnet(:) + if (trim(coupling_mode) == 'cesm') then + c1 = 0.285; c2 = 0.285; c3 = 0.215; c4 = 0.215 + Foxx_swnet_vdr(:) = c1 * Foxx_swnet(:) + Foxx_swnet_vdf(:) = c2 * Foxx_swnet(:) + Foxx_swnet_idr(:) = c3 * Foxx_swnet(:) + Foxx_swnet_idf(:) = c4 * Foxx_swnet(:) + else + Foxx_swnet_vdr(:) = Faxa_swvdr(:) * (1.0_R8 - avsdr(:)) + Foxx_swnet_vdf(:) = Faxa_swvdf(:) * (1.0_R8 - avsdf(:)) + Foxx_swnet_idr(:) = Faxa_swndr(:) * (1.0_R8 - anidr(:)) + Foxx_swnet_idf(:) = Faxa_swndf(:) * (1.0_R8 - anidf(:)) + end if end if end if diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index c690aa522..93755d59c 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -19,7 +19,7 @@ module med_phases_prep_wav_mod use med_methods_mod , only : FB_reset => med_methods_FB_reset use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use esmFlds , only : med_fldList_GetfldListTo - use med_internalstate_mod , only : compwav + use med_internalstate_mod , only : compatm, compwav use perf_mod , only : t_startf, t_stopf implicit none @@ -92,12 +92,39 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) rc = ESMF_SUCCESS call memcheck(subname, 5, maintask) - ! Get the internal state + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! auto merges to wav + !--------------------------------------- + ! --- map atm to wav, only if data stream is available + !--------------------------------------- + if (is_local%wrap%med_coupling_active(compatm,compwav) .and. & + is_local%wrap%med_data_active(compatm,compwav) .and. & + is_local%wrap%med_data_force_first(compwav)) then + call t_startf('MED:'//trim(subname)//' map_atm2wav') + call med_map_field_packed( & + FBSrc=is_local%wrap%FBImp(compatm,compatm), & + FBDst=is_local%wrap%FBImp(compatm,compwav), & + FBFracSrc=is_local%wrap%FBFrac(compatm), & + FBDat=is_local%wrap%FBData(compwav), & + use_data=is_local%wrap%med_data_force_first(compwav), & + field_normOne=is_local%wrap%field_normOne(compatm,compwav,:), & + packed_data=is_local%wrap%packed_data(compatm,compwav,:), & + routehandles=is_local%wrap%RH(compatm,compwav,:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//trim(subname)//' map_atm2wav') + + ! Reset flag to use data + is_local%wrap%med_data_force_first(compwav) = .false. + end if + + !--------------------------------------- + !--- merge all fields to wav + !--------------------------------------- call med_merge_auto(& is_local%wrap%med_coupling_active(:,compwav), & is_local%wrap%FBExp(compwav), & From 14878f49cbfb15c422bf54718214e7af5555f8a9 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Sun, 3 Mar 2024 08:19:59 -0500 Subject: [PATCH 4/8] add cpl_scalar for tiled grids, other minor fixes * add new cpl_scalar for mediator history files for tiled gridded domains, eg cube-sphere. Replaces existing use of config variables which restricted the use to 6-tiles domain * remove unnecessary trims, fix minor typos and indentation --- mediator/med.F90 | 34 +++++++--- mediator/med_fraction_mod.F90 | 6 +- mediator/med_internalstate_mod.F90 | 8 ++- mediator/med_io_mod.F90 | 41 ++++++----- mediator/med_map_mod.F90 | 102 ++++++++++++++-------------- mediator/med_phases_history_mod.F90 | 42 ++++-------- 6 files changed, 117 insertions(+), 116 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 4a8d3d90b..7c379ad90 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -510,7 +510,7 @@ subroutine SetServices(gcomp, rc) #ifdef CDEPS_INLINE !------------------ - ! phase routine for cdeps inline capabilty + ! phase routine for cdeps inline capabilty !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & @@ -832,10 +832,10 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) if (trim(coupling_mode) == 'cesm') then call esmFldsExchange_cesm(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode(1:3)) == 'ufs') then + else if (coupling_mode(1:3) == 'ufs') then call esmFldsExchange_ufs(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode(1:4)) == 'hafs') then + else if (coupling_mode(1:4) == 'hafs') then call esmFldsExchange_hafs(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else @@ -867,6 +867,15 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) is_local%wrap%flds_scalar_index_ny + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNTile", value=cvalue, & + isPresent=isPresent, isSet=isSet,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) is_local%wrap%flds_scalar_index_ntile + else + is_local%wrap%flds_scalar_index_ntile = 0 + end if + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -962,7 +971,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) endif if (maintask) then write(logunit,*) trim(compname(ncomp))//'_use_data_first_import is ', is_local%wrap%med_data_force_first(ncomp) - endif + endif end if end do @@ -1067,7 +1076,7 @@ subroutine ModifyDecompofMesh(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ - ! Recieve Grids + ! Receive Grids !------------------ do n1 = 1,ncomps @@ -1644,7 +1653,7 @@ subroutine DataInitialize(gcomp, rc) logical :: read_restart logical :: allDone = .false. logical,save :: first_call = .true. - real(r8) :: real_nx, real_ny + real(r8) :: real_nx, real_ny, real_ntile character(len=CX) :: msgString character(len=*), parameter :: subname = '('//__FILE__//':DataInitialize)' !----------------------------------------------------------- @@ -1832,7 +1841,7 @@ subroutine DataInitialize(gcomp, rc) if (trim(coupling_mode) == 'cesm') then call esmFldsExchange_cesm(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode(1:3)) == 'ufs') then + else if (coupling_mode(1:3) == 'ufs') then call esmFldsExchange_ufs(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (coupling_mode(1:4) == 'hafs') then @@ -2128,11 +2137,18 @@ subroutine DataInitialize(gcomp, rc) flds_scalar_name=is_local%wrap%flds_scalar_name, & flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call State_GetScalar(scalar_value=real_ntile, & + scalar_id=is_local%wrap%flds_scalar_index_ntile, & + state=is_local%wrap%NstateImp(n1), & + flds_scalar_name=is_local%wrap%flds_scalar_name, & + flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return is_local%wrap%nx(n1) = nint(real_nx) is_local%wrap%ny(n1) = nint(real_ny) - write(msgString,'(2i8,2l4)') is_local%wrap%nx(n1), is_local%wrap%ny(n1) + is_local%wrap%ntile(n1) = nint(real_ntile) + write(msgString,'(3i8)') is_local%wrap%nx(n1), is_local%wrap%ny(n1), is_local%wrap%ntile(n1) if (maintask) then - write(logunit,'(a)') 'global nx,ny sizes for '//trim(compname(n1))//":"//trim(msgString) + write(logunit,'(a)') 'global nx,ny,ntile sizes for '//trim(compname(n1))//":"//trim(msgString) end if call ESMF_LogWrite(trim(subname)//":"//trim(compname(n1))//":"//trim(msgString), ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 2f7d43041..b0cd53a61 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -293,7 +293,7 @@ subroutine med_fraction_init(gcomp, rc) ! If ice and atm are on the same mesh - a redist route handle has already been created maptype = mapfcopy else - if (trim(coupling_mode(1:9)) == 'ufs.nfrac' ) then + if (coupling_mode(1:9) == 'ufs.nfrac' ) then maptype = mapnstod_consd else maptype = mapconsd @@ -345,7 +345,7 @@ subroutine med_fraction_init(gcomp, rc) ! If ocn and atm are on the same mesh - a redist route handle has already been created maptype = mapfcopy else - if (trim(coupling_mode(1:9)) == 'ufs.nfrac' ) then + if (coupling_mode(1:9) == 'ufs.nfrac' ) then maptype = mapnstod_consd else maptype = mapconsd @@ -756,7 +756,7 @@ subroutine med_fraction_set(gcomp, rc) call t_startf('MED:'//trim(subname)//' fbfrac(compatm)') ! Determine maptype - if (trim(coupling_mode(1:9)) == 'ufs.nfrac' ) then + if (coupling_mode(1:9) == 'ufs.nfrac' ) then maptype = mapnstod_consd else if (med_map_RH_is_created(is_local%wrap%RH(compice,compatm,:),mapfcopy, rc=rc)) then diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index b06f20c1c..5609f5ea6 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -121,7 +121,7 @@ module med_internalstate_mod ! Present/allowed coupling/active coupling logical flags logical, pointer :: comp_present(:) ! comp present flag logical, pointer :: med_coupling_active(:,:) ! computes the active coupling - logical, pointer :: med_data_active(:,:) ! uses stream data to provide background fill + logical, pointer :: med_data_active(:,:) ! uses stream data to provide background fill logical, pointer :: med_data_force_first(:) ! force to use stream data for first coupling timestep integer :: num_icesheets ! obtained from attribute logical :: ocn2glc_coupling = .false. ! obtained from attribute @@ -132,13 +132,14 @@ module med_internalstate_mod type(ESMF_VM) :: vm ! Global nx,ny dimensions of input arrays (needed for mediator history output) - integer, pointer :: nx(:), ny(:) + integer, pointer :: nx(:), ny(:), ntile(:) ! Import/Export Scalars character(len=CL) :: flds_scalar_name = '' integer :: flds_scalar_num = 0 integer :: flds_scalar_index_nx = 0 integer :: flds_scalar_index_ny = 0 + integer :: flds_scalar_index_ntile = 0 integer :: flds_scalar_index_nextsw_cday = 0 integer :: flds_scalar_index_precip_factor = 0 real(r8) :: flds_scalar_precip_factor = 1._r8 ! actual value of precip factor from ocn @@ -312,6 +313,7 @@ subroutine med_internalstate_init(gcomp, rc) allocate(is_local%wrap%med_data_force_first(ncomps)) allocate(is_local%wrap%nx(ncomps)) allocate(is_local%wrap%ny(ncomps)) + allocate(is_local%wrap%ntile(ncomps)) allocate(is_local%wrap%NStateImp(ncomps)) allocate(is_local%wrap%NStateExp(ncomps)) allocate(is_local%wrap%FBImp(ncomps,ncomps)) @@ -601,7 +603,7 @@ subroutine med_internalstate_defaultmasks(gcomp, rc) if (is_local%wrap%comp_present(compocn)) defaultMasks(compocn,:) = 0 if (is_local%wrap%comp_present(compice)) defaultMasks(compice,:) = 0 if (is_local%wrap%comp_present(compwav)) defaultMasks(compwav,:) = 0 - if ( trim(coupling_mode(1:3)) == 'ufs') then + if ( coupling_mode(1:3) == 'ufs') then if (is_local%wrap%comp_present(compatm)) defaultMasks(compatm,:) = 1 endif if ( trim(coupling_mode) == 'hafs') then diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 265a5ddda..f4abadaf6 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -698,7 +698,7 @@ end function med_io_sec2hms !=============================================================================== subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & - fillval, pre, flds, tavg, use_float, tilesize, rc) + fillval, pre, flds, tavg, use_float, ntile, rc) !--------------- ! Write FB to netcdf file @@ -728,7 +728,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & character(len=*), optional , intent(in) :: flds(:) ! specific fields to write out logical, optional , intent(in) :: tavg ! is this a tavg logical, optional , intent(in) :: use_float ! write output as float rather than double - integer, optional , intent(in) :: tilesize ! if non-zero, write atm component on tiles + integer, optional , intent(in) :: ntile ! number of nx * ny tiles integer , intent(out):: rc ! local variables @@ -754,7 +754,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & character(CS) :: coordvarnames(2) ! coordinate variable names character(CS) :: coordnames(2) ! coordinate long names character(CS) :: coordunits(2) ! coordinate units - integer :: lnx,lny + integer :: lnx,lny,lntile logical :: luse_float real(r8) :: lfillvalue integer, pointer :: minIndexPTile(:,:) @@ -770,8 +770,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & integer :: rank integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields integer :: gridToFieldMap(1) ! currently the size must equal 1 for rank 2 fields - logical :: atmtiles - integer :: ntiles = 1 + logical :: tiles character(CL), allocatable :: fieldNameList(:) character(*),parameter :: subName = '(med_io_write_FB) ' !------------------------------------------------------------------------------- @@ -785,9 +784,9 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & luse_float = .false. if (present(use_float)) luse_float = use_float - atmtiles = .false. - if (present(tilesize)) then - if (tilesize > 0) atmtiles = .true. + tiles = .false. + if (present(ntile)) then + if (ntile > 0) tiles = .true. end if ! Error check @@ -870,14 +869,14 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & ! all the global grid values in the distgrid - e.g. CTSM ng = maxval(maxIndexPTile) - if (atmtiles) then - lnx = tilesize - lny = tilesize - ntiles = ng/(lnx*lny) - write(tmpstr,*) subname, 'ng,lnx,lny,ntiles = ',ng,lnx,lny,ntiles + if (tiles) then + lnx = nx + lny = ny + lntile = ng/(lnx*lny) + write(tmpstr,*) subname, 'ng,lnx,lny,lntile = ',ng,lnx,lny,lntile call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - if (ntiles /= 6) then - call ESMF_LogWrite(trim(subname)//' ERROR: only cubed sphere atm tiles valid ', ESMF_LOGMSG_INFO) + if (lntile /= ntile) then + call ESMF_LogWrite(trim(subname)//' ERROR: grid2d size and ntile are not consistent ', ESMF_LOGMSG_INFO) call ESMF_Finalize(endflag=ESMF_END_ABORT) endif else @@ -900,10 +899,10 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & ! Write header if (whead) then - if (atmtiles) then + if (tiles) then rcode = pio_def_dim(io_file, trim(lpre)//'_nx', lnx, dimid3(1)) rcode = pio_def_dim(io_file, trim(lpre)//'_ny', lny, dimid3(2)) - rcode = pio_def_dim(io_file, trim(lpre)//'_ntiles', ntiles, dimid3(3)) + rcode = pio_def_dim(io_file, trim(lpre)//'_ntile', ntile, dimid3(3)) if (present(nt)) then dimid4(1:3) = dimid3 rcode = pio_inq_dimid(io_file, 'time', dimid4(4)) @@ -1020,8 +1019,8 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) write(tmpstr,*) subname,' dof = ',ns,size(dof),dof(1),dof(ns) !,minval(dof),maxval(dof) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - if (atmtiles) then - call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny,ntiles/), dof, iodesc) + if (tiles) then + call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny,ntile/), dof, iodesc) else call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) !call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom) @@ -1579,8 +1578,8 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc) allocate(fldptr1_tmp(lsize)) do n = 1,ungriddedUBound(1) - ! Creat a name for the 1d field on the mediator history or restart file based on the - ! ungridded dimension index of the field bundle 2d fiedl + ! Create a name for the 1d field on the mediator history or restart file based on the + ! ungridded dimension index of the field bundle 2d field write(cnumber,'(i0)') n name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index f77d4242e..2c4da67b4 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -408,7 +408,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, dstMaskValue = ispval_mask endif end if - if (trim(coupling_mode(1:3)) == 'ufs') then + if (coupling_mode(1:3) == 'ufs') then if (n1 == compatm .and. n2 == complnd) then srcMaskValue = ispval_mask dstMaskValue = ispval_mask @@ -424,7 +424,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, call ESMF_LogWrite(trim(string), ESMF_LOGMSG_INFO) polemethod=ESMF_POLEMETHOD_ALLAVG - if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode(1:3)) == 'ufs') then + if (trim(coupling_mode) == 'cesm' .or. coupling_mode(1:3) == 'ufs') then if (n1 == compwav .or. n2 == compwav) then polemethod = ESMF_POLEMETHOD_NONE ! todo: remove this when ESMF tripolar mapping fix is in place. endif @@ -949,7 +949,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ type(ESMF_FieldBundle) , intent(in) :: FBFracSrc ! fraction field bundle for source type(packed_data_type) , intent(inout) :: packed_data(:) ! array over mapping types type(ESMF_RouteHandle) , intent(inout) :: routehandles(:) - type(ESMF_FieldBundle), optional, intent(in) :: FBDat ! data field bundle + type(ESMF_FieldBundle), optional, intent(in) :: FBDat ! data field bundle logical, optional , intent(in) :: use_data ! skip mapping and use data instead integer, optional , intent(out) :: rc @@ -1008,7 +1008,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ allocate(field_namelist_dat(fieldcount_dat)) call ESMF_FieldBundleGet(FBDat, fieldlist=fieldlist_dat, fieldNameList=field_namelist_dat, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - + if (present(use_data)) skip_mapping = use_data end if end if @@ -1072,7 +1072,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ call t_stopf('MED:'//trim(subname)//' copy from src') ! ----------------------------------- - ! Fill destination field with background data provided by CDEPS inline + ! Fill destination field with background data provided by CDEPS inline ! ----------------------------------- if (fieldcount_dat > 0) then @@ -1085,52 +1085,52 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ ! Get the indices into the packed data structure np = packed_data(mapindex)%fldindex(nf) if (np > 0) then - ! Get size of ungridded dimension and name of the field - call ESMF_FieldGet(fieldlist_dst(nf), ungriddedUBound=ungriddedUBound, name=field_name, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (maintask) write(logunit,'(a)') trim(subname)//" search "//trim(field_name)//" field for background fill." - - ! Check if field has match in data fields - isFound = .false. - do nfd = 1, fieldcount_dat - ! Debug output for checked fields to find match - if (maintask .and. dbug_flag > 1) write(logunit,'(a)') trim(field_name)//" - "//trim(field_namelist_dat(nfd)) - - if (trim(field_name) == trim(field_namelist_dat(nfd))) then - ! Debug output about match - if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_namelist_dat(nfd))//" is found!" - - ! Get pointer from data field - call ESMF_FieldGet(fieldlist_dat(nfd), farrayptr=dataptr, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (dbug_flag > 1) then - call Field_diagnose(packed_data(mapindex)%field_dst, trim(field_name), " --> before background fill: ", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - - ! Fill destination field with background data coming from stream - dataptr2d_packed(np,:) = dataptr(:) - - if (dbug_flag > 1) then - call Field_diagnose(packed_data(mapindex)%field_dst, trim(field_name), " --> after background fill: ", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - - ! Exit from loop since match is already found - isFound = .true. - exit - end if - end do ! loop for stream fields - - ! Could not find match in the list of stream fields - if (.not. isFound) then - if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_name)//" is not found!" - - ! Fill destination field with very large background data - dataptr2d_packed(np,:) = fillValue - end if + ! Get size of ungridded dimension and name of the field + call ESMF_FieldGet(fieldlist_dst(nf), ungriddedUBound=ungriddedUBound, name=field_name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (maintask) write(logunit,'(a)') trim(subname)//" search "//trim(field_name)//" field for background fill." + + ! Check if field has match in data fields + isFound = .false. + do nfd = 1, fieldcount_dat + ! Debug output for checked fields to find match + if (maintask .and. dbug_flag > 1) write(logunit,'(a)') trim(field_name)//" - "//trim(field_namelist_dat(nfd)) + + if (trim(field_name) == trim(field_namelist_dat(nfd))) then + ! Debug output about match + if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_namelist_dat(nfd))//" is found!" + + ! Get pointer from data field + call ESMF_FieldGet(fieldlist_dat(nfd), farrayptr=dataptr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 1) then + call Field_diagnose(packed_data(mapindex)%field_dst, trim(field_name), " --> before background fill: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! Fill destination field with background data coming from stream + dataptr2d_packed(np,:) = dataptr(:) + + if (dbug_flag > 1) then + call Field_diagnose(packed_data(mapindex)%field_dst, trim(field_name), " --> after background fill: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! Exit from loop since match is already found + isFound = .true. + exit + end if + end do ! loop for stream fields + + ! Could not find match in the list of stream fields + if (.not. isFound) then + if (maintask) write(logunit,'(a)') trim(subname)//" field "//trim(field_name)//" is not found!" + + ! Fill destination field with very large background data + dataptr2d_packed(np,:) = fillValue + end if end if end do ! loop for destination fields diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 7d59a7fea..606b6159b 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -322,12 +322,14 @@ subroutine med_phases_history_write(gcomp, rc) if (is_local%wrap%comp_present(n)) then if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then call med_io_write(io_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), & - is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Imp', rc=rc) + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Imp', & + ntile=is_local%wrap%ntile(n), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then call med_io_write(io_file, is_local%wrap%FBexp(n), whead(m), wdata(m), & - is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Exp', rc=rc) + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Exp', & + ntile=is_local%wrap%ntile(n), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif end if @@ -672,13 +674,13 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) integer :: hist_n ! freq_n setting relative to freq_option character(CL) :: hist_option_in character(CL) :: hist_n_in - integer :: hist_tilesize logical :: isPresent logical :: isSet type(ESMF_VM) :: vm type(ESMF_Calendar) :: calendar ! calendar type integer :: m ! indices integer :: nx,ny ! global grid size + integer :: ntile ! number of tiles for tiled domain eg CSG character(CL) :: time_units ! units of time variable character(CL) :: hist_file ! history file name real(r8) :: time_val ! time coordinate output @@ -694,16 +696,6 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine if tiled output to history file is requested - call NUOPC_CompAttributeGet(gcomp, name='history_tile_'//trim(compname(compid)), isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - call NUOPC_CompAttributeGet(gcomp, name='history_tile_'//trim(compname(compid)), value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) hist_tilesize - else - hist_tilesize = 0 - end if ! alarm is not set determine hist_option and hist_n if (.not. instfile%is_clockset) then @@ -775,22 +767,23 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) nx = is_local%wrap%nx(compid) ny = is_local%wrap%ny(compid) + ntile = is_local%wrap%ntile(compid) ! Define/write import field bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then call med_io_write(instfile%io_file, is_local%wrap%FBimp(compid,compid), whead(m), wdata(m), nx, ny, & - nt=1, pre=trim(compname(compid))//'Imp', tilesize=hist_tilesize, rc=rc) + nt=1, pre=trim(compname(compid))//'Imp', ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Define/write import export bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then call med_io_write(instfile%io_file, is_local%wrap%FBexp(compid), whead(m), wdata(m), nx, ny, & - nt=1, pre=trim(compname(compid))//'Exp', tilesize=hist_tilesize, rc=rc) + nt=1, pre=trim(compname(compid))//'Exp', ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Define/Write mediator fractions if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(compid),rc=rc)) then call med_io_write(instfile%io_file, is_local%wrap%FBFrac(compid), whead(m), wdata(m), nx, ny, & - nt=1, pre='Med_frac_'//trim(compname(compid)), tilesize=hist_tilesize, rc=rc) + nt=1, pre='Med_frac_'//trim(compname(compid)), ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -830,13 +823,13 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) integer :: hist_n ! freq_n setting relative to freq_option character(CL) :: hist_option_in character(CL) :: hist_n_in - integer :: hist_tilesize logical :: isPresent logical :: isSet type(ESMF_VM) :: vm type(ESMF_Calendar) :: calendar ! calendar type integer :: m ! indices integer :: nx,ny ! global grid size + integer :: ntile ! number of tiles for tiled domain eg CSG character(CL) :: time_units ! units of time variable character(CL) :: hist_file ! history file name real(r8) :: time_val ! time coordinate output @@ -854,16 +847,6 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine if tiled output to history file is requested - call NUOPC_CompAttributeGet(gcomp, name='history_tile_'//trim(compname(compid)), isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - call NUOPC_CompAttributeGet(gcomp, name='history_tile_'//trim(compname(compid)), value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) hist_tilesize - else - hist_tilesize = 0 - end if ! alarm is not set determine hist_option and hist_n if (.not. avgfile%is_clockset) then @@ -982,9 +965,10 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) if (is_local%wrap%comp_present(compid)) then nx = is_local%wrap%nx(compid) ny = is_local%wrap%ny(compid) + ntile = is_local%wrap%ntile(compid) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then call med_io_write(avgfile%io_file, avgfile%FBaccum_import, whead(m), wdata(m), nx, ny, & - nt=1, pre=trim(compname(compid))//'Imp', tilesize=hist_tilesize, rc=rc) + nt=1, pre=trim(compname(compid))//'Imp', ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (wdata(m)) then call med_methods_FB_reset(avgfile%FBAccum_import, czero, rc=rc) @@ -993,7 +977,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then call med_io_write(avgfile%io_file, avgfile%FBaccum_export, whead(m), wdata(m), nx, ny, & - nt=1, pre=trim(compname(compid))//'Exp', tilesize=hist_tilesize, rc=rc) + nt=1, pre=trim(compname(compid))//'Exp', ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (wdata(m)) then call med_methods_FB_reset(avgfile%FBAccum_export, czero, rc=rc) From 3515360f67a4f17ed6788646ff5851e347f0c57e Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sun, 3 Mar 2024 13:51:44 -0500 Subject: [PATCH 5/8] set ntile=0 when ntile scalar doesn't exist --- mediator/med.F90 | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 7c379ad90..9c7572a90 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -882,7 +882,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) if (isPresent .and. isSet) then read(cvalue,*) is_local%wrap%flds_scalar_index_nextsw_cday else - is_local%wrap%flds_scalar_index_nextsw_cday = spval + is_local%wrap%flds_scalar_index_nextsw_cday = 0 end if call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxPrecipFactor", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) @@ -2137,15 +2137,19 @@ subroutine DataInitialize(gcomp, rc) flds_scalar_name=is_local%wrap%flds_scalar_name, & flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call State_GetScalar(scalar_value=real_ntile, & - scalar_id=is_local%wrap%flds_scalar_index_ntile, & - state=is_local%wrap%NstateImp(n1), & - flds_scalar_name=is_local%wrap%flds_scalar_name, & - flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (is_local%wrap%flds_scalar_index_ntile > 0) then + call State_GetScalar(scalar_value=real_ntile, & + scalar_id=is_local%wrap%flds_scalar_index_ntile, & + state=is_local%wrap%NstateImp(n1), & + flds_scalar_name=is_local%wrap%flds_scalar_name, & + flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + is_local%wrap%ntile(n1) = nint(real_ntile) + else + is_local%wrap%ntile(n1) = 0 + end if is_local%wrap%nx(n1) = nint(real_nx) is_local%wrap%ny(n1) = nint(real_ny) - is_local%wrap%ntile(n1) = nint(real_ntile) write(msgString,'(3i8)') is_local%wrap%nx(n1), is_local%wrap%ny(n1), is_local%wrap%ntile(n1) if (maintask) then write(logunit,'(a)') 'global nx,ny,ntile sizes for '//trim(compname(n1))//":"//trim(msgString) From ac5520fa195cf5136f0a836b7183cf06d87d052f Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 4 Mar 2024 17:11:56 -0500 Subject: [PATCH 6/8] fix restarts when ntile>0 --- mediator/med.F90 | 2 +- mediator/med_internalstate_mod.F90 | 4 +++- mediator/med_phases_restart_mod.F90 | 4 ++++ 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 9c7572a90..dc0f68cf2 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -510,7 +510,7 @@ subroutine SetServices(gcomp, rc) #ifdef CDEPS_INLINE !------------------ - ! phase routine for cdeps inline capabilty + ! phase routine for cdeps inline capability !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 5609f5ea6..e45331f76 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -132,7 +132,9 @@ module med_internalstate_mod type(ESMF_VM) :: vm ! Global nx,ny dimensions of input arrays (needed for mediator history output) - integer, pointer :: nx(:), ny(:), ntile(:) + integer, pointer :: nx(:), ny(:) + ! Number of nx*ny domains (needed for cubed-sphere and regional domains) + integer, pointer :: ntile(:) ! Import/Export Scalars character(len=CL) :: flds_scalar_name = '' diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index a225ff97c..1bbbb0fbf 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -346,6 +346,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (is_local%wrap%comp_present(n)) then nx = is_local%wrap%nx(n) ny = is_local%wrap%ny(n) + if (is_local%wrap%ntile(n) > 0) then + nx = is_local%wrap%ntile(n)*is_local%wrap%ny(n)*is_local%wrap%nx(n) + ny = 1 + end if ! Write import field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then call med_io_write(io_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), nx, ny, & From 45d63c4384b8244cdc596435c94fd946c5b9761c Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Wed, 13 Mar 2024 10:02:36 -0600 Subject: [PATCH 7/8] add two fixes * testing of this feature w/ UFS noahmp lnd component, which currently runs on the CSG, found two issues. One to write the mediator fractions and areas on the tiles when using the single history file. A second fix is the mapping masking for lnd-atm coupling in UFS. --- mediator/med_map_mod.F90 | 4 ++++ mediator/med_phases_history_mod.F90 | 6 ++++-- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 2c4da67b4..c20fe4bdc 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -413,6 +413,10 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, srcMaskValue = ispval_mask dstMaskValue = ispval_mask end if + if (n1 == complnd .and. n2 == compatm) then + srcMaskValue = ispval_mask + dstMaskValue = 0 + end if end if if (coupling_mode(1:4) == 'hafs') then if (n1 == compatm .and. n2 == compwav) then diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 606b6159b..52b20c035 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -336,12 +336,14 @@ subroutine med_phases_history_write(gcomp, rc) ! Write mediator fraction field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(n),rc=rc)) then call med_io_write(io_file, is_local%wrap%FBFrac(n), whead(m), wdata(m), & - is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='Med_frac_'//trim(compname(n)), rc=rc) + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='Med_frac_'//trim(compname(n)), & + ntile=is_local%wrap%ntile(n), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Write component mediator area field bundles call med_io_write(io_file, is_local%wrap%FBArea(n), whead(m), wdata(m), & - is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='MED_'//trim(compname(n)), rc=rc) + is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='MED_'//trim(compname(n)), & + ntile=is_local%wrap%ntile(n), rc=rc) end do ! Write atm/ocn fluxes and ocean albedoes if field bundles are created From 8309884aa4ef46caa672b3e38fd0b6a9bc18c199 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Wed, 13 Mar 2024 18:28:59 -0400 Subject: [PATCH 8/8] modify dstmask for lnd->atm in UFS --- mediator/med_map_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index c20fe4bdc..3d888bcfa 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -415,7 +415,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, end if if (n1 == complnd .and. n2 == compatm) then srcMaskValue = ispval_mask - dstMaskValue = 0 + dstMaskValue = ispval_mask end if end if if (coupling_mode(1:4) == 'hafs') then