diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index ebc3c8b29..acda38634 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -19,7 +19,7 @@ jobs: strategy: fail-fast: false matrix: - python-version: [ 3.8, 3.11, 3.x ] + python-version: [ "3.10", 3.12, 3.x ] env: CC: mpicc FC: mpifort diff --git a/CODEOWNERS b/CODEOWNERS new file mode 100644 index 000000000..0005a3b9c --- /dev/null +++ b/CODEOWNERS @@ -0,0 +1 @@ +/cesm/flux_atmocn/ @megandevlan diff --git a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 index e98e79aea..15e38d02a 100644 --- a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 @@ -24,6 +24,7 @@ module flux_atmocn_COARE_mod use shr_flux_mod, only : loc_stebol, loc_latvap, loc_g, loc_cpdair use shr_flux_mod, only : td0, maxscl, alpha, use_coldair_outbreak_mod use shr_const_mod, only : shr_const_rgas + use shr_wv_sat_mod, only: shr_wv_sat_qsat_liquid ! use saturation calculation consistent with CAM implicit none private @@ -44,6 +45,7 @@ subroutine flux_atmOcn_COARE( & ts, mask, seq_flux_atmocn_minwind, & sen, lat, lwup, evap, & taux ,tauy, tref, qref, & + aofluxes_use_shr_wv_sat, & duu10n, ugust_out, u10res, & ustar_sv, re_sv, ssq_sv) @@ -52,6 +54,7 @@ subroutine flux_atmOcn_COARE( & real(R8) , intent(in) :: spval integer , intent(in) :: nMax ! data vector length integer , intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain + logical , intent(in) :: aofluxes_use_shr_wv_sat ! use shr_wv_sat_mod to calculate qsat for atm-ocn flux calculations 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) @@ -106,6 +109,8 @@ subroutine flux_atmOcn_COARE( & real(R8) :: hsb,hlb ! sens & lat heat flxs at zbot real(R8) :: tau ! stress at zbot real(R8) :: trf,qrf,urf,vrf ! reference-height quantities + real(r8) :: esat_val ! value of esat (saturation vapor pressure) at this point + real(r8) :: qsat_val ! value of qsat (saturation specific humidity) at this point !--- local functions -------------------------------- real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) @@ -146,7 +151,16 @@ subroutine flux_atmOcn_COARE( & vmag=vmag*vscl endif endif - ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) + + if (aofluxes_use_shr_wv_sat) then + ! This version uses a qsat calculation method consistent with what's used in CAM + call shr_wv_sat_qsat_liquid(ts(n), pslv(n), esat_val, qsat_val) + ssq = 0.98_R8 * qsat_val ! sea surf hum (kg/kg) + else + ! This version uses the qsat calculation method that was used for many years, + ! prior to Aug 2025, and which is still being used by default in NorESM + ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) + end if call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n), & ! in atm params us(n),vs(n),ts(n),ssq, & ! in surf params diff --git a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 index ed0dd9a4a..8e4106409 100644 --- a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 @@ -26,7 +26,6 @@ module flux_atmocn_diurnal_mod use shr_const_mod, only : shr_const_ocn_ref_sal, shr_const_zsrflyr, shr_const_rgas use shr_sys_mod, only : shr_sys_abort use flux_atmocn_COARE_mod, only : cor30a - use shr_wv_sat_mod, only : shr_wv_sat_qsat_liquid ! use saturation calculation consistent with CAM implicit none private @@ -236,7 +235,8 @@ subroutine flux_atmOcn_diurnal( & real(R8) :: tdiff(nMax) ! tbot - ts real(R8) :: vscl - ! NOTE: this should use the shr_wv_sat_qsat_liquid if this routine is ever used in production + ! NOTE: this should use the shr_wv_sat_qsat_liquid if this routine is ever used in + ! production (see https://github.com/ESCOMP/CMEPS/issues/624) qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) 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 @@ -354,10 +354,9 @@ subroutine flux_atmOcn_diurnal( & speed(n) = 0.0_R8 endif - ! This should be changed to use the subroutine below + ! This should be changed to use shr_wv_sat_qsat_liquid (see + ! https://github.com/ESCOMP/CMEPS/issues/624) ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) - ! call shr_wv_sat_qsat_liquid(tBulk(n), pslv(n), qsat, ssq) - ! ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) delt = thbot(n) - tBulk(n) ! pot temp diff (K) delq = qbot(n) - ssq ! spec hum dif (kg/kg) @@ -503,10 +502,9 @@ subroutine flux_atmOcn_diurnal( & !--need to update ssq,delt,delq as function of tBulk ---- - ! This should be changed to use the subroutine below + ! This should be changed to use shr_wv_sat_qsat_liquid (see + ! https://github.com/ESCOMP/CMEPS/issues/624) ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) - ! call shr_wv_sat_qsat_liquid(tBulk(n), pslv(n), qsat, ssq) - ! ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) delt = thbot(n) - tBulk(n) ! pot temp diff (K) delq = qbot(n) - ssq ! spec hum dif (kg/kg) diff --git a/cesm/flux_atmocn/flux_atmocn_Large.F90 b/cesm/flux_atmocn/flux_atmocn_Large.F90 index 8bfedaa9b..b0df413db 100644 --- a/cesm/flux_atmocn/flux_atmocn_Large.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Large.F90 @@ -25,6 +25,7 @@ module flux_atmOcn_large_mod use shr_flux_mod, only: flux_con_tol, flux_con_max_iter use shr_flux_mod, only: alpha, maxscl, td0 use shr_sys_mod, only: shr_sys_abort + use shr_wv_sat_mod, only: shr_wv_sat_qsat_liquid ! use saturation calculation consistent with CAM implicit none public @@ -41,7 +42,8 @@ subroutine flux_atmOcn_large( & ts, mask, seq_flux_atmocn_minwind, & sen, lat, lwup, evap, & taux, tauy, tref, qref, & - add_gusts, duu10n, ugust_out, u10res, & + add_gusts, aofluxes_use_shr_wv_sat, & + duu10n, ugust_out, u10res, & ustar_sv, re_sv, ssq_sv) !--- input arguments -------------------------------- @@ -50,6 +52,7 @@ subroutine flux_atmOcn_large( & integer ,intent(in) :: nMax ! data vector length integer ,intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain logical ,intent(in) :: add_gusts + logical ,intent(in) :: aofluxes_use_shr_wv_sat ! use shr_wv_sat_mod to calculate qsat for atm-ocn flux calculations 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) @@ -120,6 +123,8 @@ subroutine flux_atmOcn_large( & real(R8) :: cp ! specific heat of moist air real(R8) :: fac ! vertical interpolation factor real(R8) :: wind0 ! resolved large-scale 10m wind (no gust added) + real(r8) :: esat_val ! value of esat (saturation vapor pressure) at this point + real(r8) :: qsat_val ! value of qsat (saturation specific humidity) at this point !--- local functions -------------------------------- real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) @@ -209,7 +214,15 @@ subroutine flux_atmOcn_large( & endif endif - ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) + if (aofluxes_use_shr_wv_sat) then + ! This version uses a qsat calculation method consistent with what's used in CAM + call shr_wv_sat_qsat_liquid(ts(n), pslv(n), esat_val, qsat_val) + ssq = 0.98_R8 * qsat_val ! sea surf hum (kg/kg) + else + ! This version uses the qsat calculation method that was used for many years, + ! prior to Aug 2025, and which is still being used by default in NorESM + ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) + end if delt = thbot(n) - ts(n) ! pot temp diff (K) delq = qbot(n) - ssq ! spec hum dif (kg/kg) alz = log(zbot(n)/zref) diff --git a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 index 82a2b97d8..6bca47e05 100644 --- a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 @@ -25,7 +25,8 @@ subroutine flux_atmOcn_driver(logunit, nMax, & sen, lat, lwup, evap, & taux, tauy, tref, qref, & ocn_surface_flux_scheme, & - add_gusts, duu10n, ugust_out, u10res, & + add_gusts, aofluxes_use_shr_wv_sat, & + duu10n, ugust_out, u10res, & ustar_sv, re_sv, ssq_sv, missval) !--- input arguments -------------------------------- @@ -33,6 +34,7 @@ subroutine flux_atmOcn_driver(logunit, nMax, & integer , intent(in) :: nMax ! data vector length integer , intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain logical , intent(in) :: add_gusts + logical , intent(in) :: aofluxes_use_shr_wv_sat ! use shr_wv_sat_mod to calculate qsat for atm-ocn flux calculations 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) @@ -94,7 +96,8 @@ subroutine flux_atmOcn_driver(logunit, nMax, & ts, mask, seq_flux_atmocn_minwind, & sen, lat, lwup, evap, & taux, tauy, tref, qref, & - add_gusts, duu10n, ugust_out, u10res, & + add_gusts, aofluxes_use_shr_wv_sat, & + duu10n, ugust_out, u10res, & ustar_sv=ustar_sv, re_sv=re_sv, ssq_sv=ssq_sv) else if (ocn_surface_flux_scheme == ocn_flux_scheme_coare) then @@ -107,6 +110,7 @@ subroutine flux_atmOcn_driver(logunit, nMax, & ts, mask, seq_flux_atmocn_minwind, & sen, lat, lwup, evap, & taux, tauy, tref, qref, & + aofluxes_use_shr_wv_sat, & duu10n, ugust_out, u10res, & ustar_sv=ustar_sv, re_sv=re_sv, ssq_sv=ssq_sv) diff --git a/cesm/nuopc_cap_share/shr_lnd2rof_tracers_mod.F90 b/cesm/nuopc_cap_share/shr_lnd2rof_tracers_mod.F90 index 079a0a77b..e673983b7 100644 --- a/cesm/nuopc_cap_share/shr_lnd2rof_tracers_mod.F90 +++ b/cesm/nuopc_cap_share/shr_lnd2rof_tracers_mod.F90 @@ -5,13 +5,12 @@ module shr_lnd2rof_tracers_mod ! lnd -> river communications !======================================================================== - use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet + use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS use shr_sys_mod , only : shr_sys_abort use shr_log_mod , only : shr_log_getLogUnit use shr_kind_mod , only : r8 => shr_kind_r8, cs => shr_kind_cs use shr_nl_mod , only : shr_nl_find_group_name - use shr_mpi_mod , only : shr_mpi_bcast implicit none private @@ -34,7 +33,6 @@ subroutine shr_lnd2rof_tracers_readnl(NLFilename, lnd2rof_tracer_list) !----- local ----- type(ESMF_VM) :: vm - integer :: i ! Indices integer :: unitn ! namelist unit number integer :: ierr ! error code logical :: exists ! if file exists or not @@ -84,8 +82,9 @@ subroutine shr_lnd2rof_tracers_readnl(NLFilename, lnd2rof_tracer_list) close( unitn ) end if end if - call shr_mpi_bcast( lnd2rof_tracers, mpicom ) - + call ESMF_VMBroadcast(vm, lnd2rof_tracers, CS, 0, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (lnd2rof_tracers /= ' ') then lnd2rof_tracer_list = trim(lnd2rof_tracers) end if diff --git a/cesm/share_wrappers/wtracers_mod.F90 b/cesm/share_wrappers/wtracers_mod.F90 new file mode 100644 index 000000000..860640720 --- /dev/null +++ b/cesm/share_wrappers/wtracers_mod.F90 @@ -0,0 +1,18 @@ +module wtracers_mod + + !----------------------------------------------------------------------------- + ! This module wraps shr_wtracers_mod from the CESM_share repository to avoid direct + ! dependencies on this share code from CMEPS. + ! + ! See also the version of wtracers_mod in the ufs directory for when we do not have + ! access to the CESM_share library. + !----------------------------------------------------------------------------- + + use shr_wtracers_mod, only : wtracers_is_wtracer_field => shr_wtracers_is_wtracer_field + + implicit none + private + + public :: wtracers_is_wtracer_field ! return true if the given field name is a water tracer field + +end module wtracers_mod diff --git a/cime_config/buildexe b/cime_config/buildexe index 4923f016d..c8664d705 100755 --- a/cime_config/buildexe +++ b/cime_config/buildexe @@ -94,6 +94,7 @@ def _main_func(): if not skip_mediator: out.write(os.path.join(cmeps_dir, "mediator") + "\n") out.write(os.path.join(cmeps_dir, "cesm", "flux_atmocn") + "\n") + out.write(os.path.join(cmeps_dir, "cesm", "share_wrappers") + "\n") out.write(os.path.join(cmeps_dir, "cesm", "driver") + "\n") # build model executable diff --git a/cime_config/buildnml b/cime_config/buildnml index d1071d5c1..1c0f3173e 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -726,7 +726,7 @@ def buildnml(case, caseroot, component): major = line[-2] if "MAJOR" in line else major minor = line[-2] if "MINOR" in line else minor logger.debug("ESMF version major {} minor {}".format(major, minor)) - expect(int(major) >= 8 and int(minor) >=4, "ESMF version should be 8.4.1 or newer") + expect(int(major) >= 9 or (int(major) >= 8 and int(minor) >=4), "ESMF version should be 8.4.1 or newer") confdir = os.path.join(case.get_value("CASEBUILD"), "cplconf") if not os.path.isdir(confdir): diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 6e933b041..626110251 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -2310,15 +2310,6 @@ determine if per ice thickness category fields are passed from ice to ocean - DO NOT EDIT (set by MOM6) - - integer - 0,1,2,3,4,5,6,7,8,9 - 1 - run_flags - env_run.xml - level of debug output, 0=minimum, 1=normal, 2=more, 3=too much - - diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 015169a92..b3f372765 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -900,15 +900,27 @@ - + integer expdef MED_attributes - Level of debug output, 0=minimum, 1=normal, 2=more, 3=too much (default: 1) + Level of debug output; higher values give progressively more output + + Some example values (other values are also accepted) + - 0: no extra debug output + - 1: a bit of debug output + - 2: a bit more debug output + - 6: a moderate amount of debug output + - 11: a lot of debug output + - 21: a huge amount of debug output + + Note that setting this to moderate - high values can lead to overwhelming amounts of output. + + (Default: 0) - $INFO_DBUG + 0 @@ -961,15 +973,34 @@ MED_attributes atm/ocn flux calculation scheme - 0 : LARGE algorithm - 1 : COARE algorithm - 2 : UA algorithm + + 0: Large and Pond + 1: COARE algorithm + 2: UA algorithm 0 1 + + logical + control + MED_attributes + + If true, use shr_wv_sat_mod to calculate qsat for atm-ocn flux calculations. + + If false, use the older inline calculation of qsat, which uses a different + formulation. + + (Currently only relevant for ocn_surface_flux_scheme = 0 or 1.) + + + + .false. + + logical control diff --git a/mediator/CMakeLists.txt b/mediator/CMakeLists.txt index 80be3d2e8..b65004c37 100644 --- a/mediator/CMakeLists.txt +++ b/mediator/CMakeLists.txt @@ -1,6 +1,7 @@ project(cmeps Fortran) set(SRCFILES esmFldsExchange_cesm_mod.F90 med_fraction_mod.F90 + med_field_info_mod.F90 med_methods_mod.F90 med_phases_prep_ice_mod.F90 med_phases_restart_mod.F90 esmFldsExchange_hafs_mod.F90 med_internalstate_mod.F90 med_phases_aofluxes_mod.F90 diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 408834d2e..dbf0f84f0 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -994,93 +994,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - ! --------------------------------------------------------------------- - ! to atm: merged reference temperature at 2 meters - ! to atm: merged 10m wind speed - ! to atm: merged reference specific humidity at 2 meters - ! to atm: merged reference specific water isoptope humidity at 2 meters - ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(complnd , 'Sl_tref') - call addfld_from(compice , 'Si_tref') - call addfld_aoflux('So_tref') - call addfld_to(compatm , 'Sx_tref') - else - if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_tref', rc=rc)) then - if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_tref', rc=rc)) then - call addmap_from(complnd , 'Sl_tref', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) - call addmrg_to(compatm , 'Sx_tref', & - mrg_from=complnd, mrg_fld='Sl_tref', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) - end if - if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_tref', rc=rc)) then - call addmap_from(compice , 'Si_tref', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg_to(compatm , 'Sx_tref', & - mrg_from=compice, mrg_fld='Si_tref', mrg_type='merge', mrg_fracname='ifrac') - end if - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_tref', rc=rc)) then - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap_aoflux('So_tref', compatm, mapconsf, 'ofrac', ocn2atm_map) - end if - call addmrg_to(compatm , 'Sx_tref', & - mrg_from=compmed, mrg_fld='So_tref', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - end if - - if (phase == 'advertise') then - call addfld_from(complnd , 'Sl_u10') - call addfld_from(compice , 'Si_u10') - call addfld_aoflux('So_u10') - call addfld_to(compatm , 'Sx_u10') - else - if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_u10', rc=rc)) then - if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_u10', rc=rc)) then - call addmap_from(complnd , 'Sl_u10', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) - call addmrg_to(compatm , 'Sx_u10', & - mrg_from=complnd, mrg_fld='Sl_u10', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) - end if - if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_u10', rc=rc)) then - call addmap_from(compice , 'Si_u10', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg_to(compatm , 'Sx_u10', & - mrg_from=compice, mrg_fld='Si_u10', mrg_type='merge', mrg_fracname='ifrac') - end if - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_u10', rc=rc)) then - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap_aoflux('So_u10', compatm, mapconsf, 'ofrac', ocn2atm_map) - end if - call addmrg_to(compatm , 'Sx_u10', & - mrg_from=compmed, mrg_fld='So_u10', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - end if - - if (phase == 'advertise') then - call addfld_from(complnd , 'Sl_qref') - call addfld_from(compice , 'Si_qref') - call addfld_aoflux('So_qref') - call addfld_to(compatm , 'Sx_qref') - else - if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref', rc=rc)) then - if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref', rc=rc)) then - call addmap_from(complnd , 'Sl_qref', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) - call addmrg_to(compatm , 'Sx_qref', & - mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) - end if - if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref', rc=rc)) then - call addmap_from(compice , 'Si_qref', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg_to(compatm , 'Sx_qref', & - mrg_from=compice, mrg_fld='Si_qref', mrg_type='merge', mrg_fracname='ifrac') - end if - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_qref', rc=rc)) then - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap_aoflux('So_qref', compatm, mapconsf, 'ofrac', ocn2atm_map) - end if - call addmrg_to(compatm , 'Sx_qref', & - mrg_from=compmed, mrg_fld='So_qref', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - end if - ! --------------------------------------------------------------------- ! to atm: merged zonal surface stress ! to atm: merged meridional surface stress diff --git a/mediator/med.F90 b/mediator/med.F90 index 075bb6d04..b56ab6530 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -37,6 +37,8 @@ module MED use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_getFieldN => med_methods_FB_getFieldN use med_methods_mod , only : clock_timeprint => med_methods_clock_timeprint + use med_field_info_mod , only : med_field_info_type + use med_field_info_mod , only : med_field_info_array_from_names_wtracers, med_field_info_array_from_state use med_utils_mod , only : memcheck => med_memcheck use med_internalstate_mod , only : InternalState, med_internalstate_init, med_internalstate_coupling use med_internalstate_mod , only : med_internalstate_defaultmasks, logunit, maintask @@ -1635,6 +1637,7 @@ subroutine DataInitialize(gcomp, rc) ! local variables type(InternalState) :: is_local + type(med_field_info_type), allocatable :: field_info_array(:) type(ESMF_Clock) :: clock type(ESMF_State) :: importState, exportState type(ESMF_Time) :: time @@ -1748,19 +1751,25 @@ subroutine DataInitialize(gcomp, rc) trim(compname(n1))//'_'//trim(compname(n2)) end if + call med_field_info_array_from_state( & + state = is_local%wrap%NStateImp(n1), & + field_info_array = field_info_array, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check import FB, if there is no field in it then use export FB ! to provide mesh information call State_GetNumFields(is_local%wrap%NStateImp(n2), fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldCount == 0) then call FB_init(is_local%wrap%FBImp(n1,n2), is_local%wrap%flds_scalar_name, & + field_info_array=field_info_array, & STgeom=is_local%wrap%NStateExp(n2), & - STflds=is_local%wrap%NStateImp(n1), & name='FBImp'//trim(compname(n1))//'_'//trim(compname(n2)), rc=rc) else call FB_init(is_local%wrap%FBImp(n1,n2), is_local%wrap%flds_scalar_name, & + field_info_array=field_info_array, & STgeom=is_local%wrap%NStateImp(n2), & - STflds=is_local%wrap%NStateImp(n1), & name='FBImp'//trim(compname(n1))//'_'//trim(compname(n2)), rc=rc) end if if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1788,14 +1797,19 @@ subroutine DataInitialize(gcomp, rc) allocate(fldnames(fieldCount)) call med_fldList_getfldnames(fldListMed_ocnalb%fields, fldnames, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_field_info_array_from_names_wtracers( & + field_names = fldnames, & + field_info_array = field_info_array, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_init(is_local%wrap%FBMed_ocnalb_a, is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compatm), fieldnamelist=fldnames, name='FBMed_ocnalb_a', rc=rc) + field_info_array=field_info_array, STgeom=is_local%wrap%NStateImp(compatm), name='FBMed_ocnalb_a', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (maintask) then write(logunit,'(a)') trim(subname)//' initializing FB FBMed_ocnalb_a' end if call FB_init(is_local%wrap%FBMed_ocnalb_o, is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compocn), fieldnamelist=fldnames, name='FBMed_ocnalb_o', rc=rc) + field_info_array = field_info_array, STgeom=is_local%wrap%NStateImp(compocn), name='FBMed_ocnalb_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (maintask) then write(logunit,'(a)') trim(subname)//' initializing FB FBMed_ocnalb_o' diff --git a/mediator/med_field_info_mod.F90 b/mediator/med_field_info_mod.F90 new file mode 100644 index 000000000..197f0a1b1 --- /dev/null +++ b/mediator/med_field_info_mod.F90 @@ -0,0 +1,225 @@ +module med_field_info_mod + + !----------------------------------------------------------------------------- + ! Defines a type and related operations for storing metadata about fields that can be + ! used to create an ESMF FieldBundle. + !----------------------------------------------------------------------------- + + use ESMF , only : ESMF_MAXSTR, ESMF_SUCCESS + use ESMF , only : ESMF_Field, ESMF_State, ESMF_AttributeGet, ESMF_StateGet + use med_utils_mod , only : ChkErr => med_utils_ChkErr + use shr_log_mod , only : shr_log_error + use wtracers_mod , only : wtracers_is_wtracer_field + + implicit none + private + + !----------------------------------------------- + ! Public methods + !----------------------------------------------- + + ! Create a single field + public :: med_field_info_create + + ! Create an array of field_info objects based on an array of names, where water tracers + ! are treated specially (being given an ungridded dimension) + public :: med_field_info_array_from_names_wtracers + + ! Create an array of field_info objects based on the fields in an ESMF State + public :: med_field_info_array_from_state + + !----------------------------------------------- + ! Types + !----------------------------------------------- + + type, public :: med_field_info_type + character(ESMF_MAXSTR) :: name + integer :: n_ungridded ! number of ungridded dimensions + + ! These arrays will be allocated to be of size ungridded_count + integer, allocatable :: ungridded_lbound(:) + integer, allocatable :: ungridded_ubound(:) + end type med_field_info_type + + character(len=*),parameter :: u_FILE_u = & + __FILE__ + +!================================================================================ +contains +!================================================================================ + + function med_field_info_create(name, ungridded_lbound, ungridded_ubound, rc) result(field_info) + ! Create a single field + + ! input/output variables + character(len=*), intent(in) :: name + + ! ungridded_lbound and ungridded_ubound must either both be present or both be absent; + ! if present, they must be the same size + integer, intent(in), optional :: ungridded_lbound(:) + integer, intent(in), optional :: ungridded_ubound(:) + + integer, intent(out) :: rc + type(med_field_info_type) :: field_info ! function result + + ! local variables + integer :: n_ungridded + character(len=*), parameter :: subname = '(med_field_info_create)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + if (present(ungridded_lbound) .neqv. present(ungridded_ubound)) then + call shr_log_error( & + subname//": ERROR: ungridded_lbound and ungridded_ubound must both be present or both absent.", & + line=__LINE__, file=u_FILE_u, rc=rc) + return + end if + + field_info%name = name + + if (present(ungridded_lbound)) then + n_ungridded = size(ungridded_lbound) + if (size(ungridded_ubound) /= n_ungridded) then + call shr_log_error( & + subname//": ERROR: ungridded_lbound and ungridded_ubound must have the same size.", & + line=__LINE__, file=u_FILE_u, rc=rc) + return + end if + field_info%n_ungridded = n_ungridded + allocate(field_info%ungridded_lbound(n_ungridded)) + allocate(field_info%ungridded_ubound(n_ungridded)) + field_info%ungridded_lbound = ungridded_lbound + field_info%ungridded_ubound = ungridded_ubound + else + field_info%n_ungridded = 0 + end if + + end function med_field_info_create + + !----------------------------------------------------------------------------- + + subroutine med_field_info_array_from_names_wtracers(field_names, field_info_array, rc) + ! Create an array of field_info objects based on an array of names, where water + ! tracers are treated specially (being given an ungridded dimension). + ! + ! It is assumed that fields generally have no ungridded dimensions. However, for + ! fields ending with the water tracer suffix, it is instead assumed that they have a + ! single ungridded dimension of size given by shr_wtracers_get_num_tracers. + ! + ! field_info_array is allocated here (and, since it has intent(out), it is + ! automatically deallocated if it is already allocated on entry to this subroutine) + + ! input/output variables + character(len=*), intent(in) :: field_names(:) + type(med_field_info_type), allocatable, intent(out) :: field_info_array(:) + integer, intent(out) :: rc + + ! local variables + integer :: i, n_fields + logical :: is_tracer + integer :: n_tracers + character(len=*), parameter :: subname = '(med_field_info_array_from_names_wtracers)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + n_fields = size(field_names) + allocate(field_info_array(n_fields)) + ! For now, hard-code n_tracers, since we haven't set up the tracer information; we'll + ! fix this in an upcoming set of changes + n_tracers = 0 + + do i = 1, n_fields + is_tracer = wtracers_is_wtracer_field(field_names(i)) + if (is_tracer) then + ! Field is a water tracer; assume a single ungridded dimension + field_info_array(i) = med_field_info_create( & + name=field_names(i), & + ungridded_lbound=[1], & + ungridded_ubound=[n_tracers], & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + ! Not a water tracer; assume no ungridded dimensions + field_info_array(i) = med_field_info_create( & + name=field_names(i), & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + end do + + end subroutine med_field_info_array_from_names_wtracers + + !----------------------------------------------------------------------------- + + subroutine med_field_info_array_from_state(state, field_info_array, rc) + ! Create an array of field_info objects based on the Fields in an ESMF State + ! + ! field_info_array is allocated here (and, since it has intent(out), it is + ! automatically deallocated if it is already allocated on entry to this subroutine) + + ! input/output variables + type(ESMF_State), intent(in) :: state + type(med_field_info_type), allocatable, intent(out) :: field_info_array(:) + integer, intent(out) :: rc + + ! local variables + integer :: i, n_fields + character(ESMF_MAXSTR), allocatable :: field_names(:) + type(ESMF_Field) :: field + logical :: is_present + integer :: n_ungridded + integer, allocatable :: ungridded_lbound(:) + integer, allocatable :: ungridded_ubound(:) + character(len=*), parameter :: subname = '(med_field_info_array_from_state)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(state, itemCount=n_fields, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(field_names(n_fields)) + allocate(field_info_array(n_fields)) + call ESMF_StateGet(state, itemNameList=field_names, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do i = 1, n_fields + call ESMF_StateGet(state, itemName=trim(field_names(i)), field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_AttributeGet(field, name="UngriddedUBound", convention="NUOPC", & + purpose="Instance", itemCount=n_ungridded, isPresent=is_present, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (.not. is_present) then + n_ungridded = 0 + end if + + if (n_ungridded == 0) then + field_info_array(i) = med_field_info_create( & + name=field_names(i), & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + allocate(ungridded_lbound(n_ungridded)) + allocate(ungridded_ubound(n_ungridded)) + call ESMF_AttributeGet(field, name="UngriddedLBound", convention="NUOPC", & + purpose="Instance", valueList=ungridded_lbound, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_AttributeGet(field, name="UngriddedUBound", convention="NUOPC", & + purpose="Instance", valueList=ungridded_ubound, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + field_info_array(i) = med_field_info_create( & + name=field_names(i), & + ungridded_lbound=ungridded_lbound, & + ungridded_ubound=ungridded_ubound, & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + deallocate(ungridded_lbound) + deallocate(ungridded_ubound) + end if + end do + + end subroutine med_field_info_array_from_state + +end module med_field_info_mod diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 7f9cfb8ba..9d58a43d1 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -135,6 +135,8 @@ module med_fraction_mod use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_map_mod , only : med_map_field use med_internalstate_mod , only : ncomps, samegrid_atmlnd + use med_field_info_mod , only : med_field_info_type + use med_field_info_mod , only : med_field_info_array_from_names_wtracers, med_field_info_array_from_state implicit none private @@ -189,6 +191,7 @@ subroutine med_fraction_init(gcomp, rc) type(InternalState) :: is_local type(ESMF_Field) :: field_src type(ESMF_Field) :: field_dst + type(med_field_info_type), allocatable :: field_info_array(:) real(R8), pointer :: frac(:) real(R8), pointer :: ofrac(:) real(R8), pointer :: aofrac(:) @@ -255,13 +258,18 @@ subroutine med_fraction_init(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! create FBFrac + call med_field_info_array_from_names_wtracers( & + field_names = fraclist(:,n1), & + field_info_array = field_info_array, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldCount == 0) then call fldbun_init(is_local%wrap%FBfrac(n1), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateExp(n1), fieldNameList=fraclist(:,n1), & + field_info_array=field_info_array, STgeom=is_local%wrap%NStateExp(n1), & name='FBfrac'//trim(compname(n1)), rc=rc) else call fldbun_init(is_local%wrap%FBfrac(n1), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(n1), fieldNameList=fraclist(:,n1), & + field_info_array=field_info_array, STgeom=is_local%wrap%NStateImp(n1), & name='FBfrac'//trim(compname(n1)), rc=rc) end if if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -673,9 +681,14 @@ subroutine med_fraction_init(gcomp, rc) if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then if (.not. med_map_RH_is_created(is_local%wrap%RH(compice,compocn,:),mapfcopy, rc=rc)) then if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compice,compocn))) then + call med_field_info_array_from_state( & + state = is_local%wrap%NStateImp(compice), & + field_info_array = field_info_array, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_init(is_local%wrap%FBImp(compice,compocn), is_local%wrap%flds_scalar_name, & + field_info_array=field_info_array, & STgeom=is_local%wrap%NStateImp(compocn), & - STflds=is_local%wrap%NStateImp(compice), & name='FBImp'//trim(compname(compice))//'_'//trim(compname(compocn)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -687,9 +700,14 @@ subroutine med_fraction_init(gcomp, rc) end if if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compice,:),mapfcopy, rc=rc)) then if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compocn,compice))) then + call med_field_info_array_from_state( & + state = is_local%wrap%NStateImp(compocn), & + field_info_array = field_info_array, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_init(is_local%wrap%FBImp(compocn,compice), is_local%wrap%flds_scalar_name, & + field_info_array = field_info_array, & STgeom=is_local%wrap%NStateImp(compice), & - STflds=is_local%wrap%NStateImp(compocn), & name='FBImp'//trim(compname(compocn))//'_'//trim(compname(compice)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index ac059bc7c..26dfa773b 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -15,6 +15,7 @@ module med_methods_mod use med_constants_mod , only : czero => med_constants_czero use med_constants_mod , only : spval_init => med_constants_spval_init use med_utils_mod , only : ChkErr => med_utils_ChkErr + use med_field_info_mod , only : med_field_info_type use shr_log_mod , only : shr_log_error implicit none private @@ -223,11 +224,14 @@ end subroutine med_methods_FB_init_pointer !----------------------------------------------------------------------------- - subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, STgeom, FBflds, STflds, name, rc) + subroutine med_methods_FB_init(FBout, flds_scalar_name, field_info_array, FBgeom, STgeom, name, rc) ! ---------------------------------------------- - ! Create FBout from fieldNameList, FBflds, STflds, FBgeom or STgeom in that order or priority - ! Pass in FBgeom OR STgeom, get mesh from that object + ! Create FBout from field_info_array (see med_field_info_mod for some convenience + ! functions for creating a field_info array from field names or an ESMF State) + ! + ! Mesh is retrieved from either FBgeom or STgeom (one of those must be present, but + ! not both) ! ---------------------------------------------- use ESMF , only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleCreate, ESMF_FieldBundleGet @@ -238,27 +242,19 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S ! input/output variables type(ESMF_FieldBundle), intent(inout) :: FBout ! output field bundle character(len=*) , intent(in) :: flds_scalar_name ! name of scalar fields - character(len=*) , intent(in), optional :: fieldNameList(:) ! names of fields to use in output field bundle + type(med_field_info_type), intent(in) :: field_info_array(:) ! info on the fields to put in the output FieldBundle type(ESMF_FieldBundle), intent(in), optional :: FBgeom ! input field bundle geometry to use type(ESMF_State) , intent(in), optional :: STgeom ! input state geometry to use - type(ESMF_FieldBundle), intent(in), optional :: FBflds ! input field bundle fields - type(ESMF_State) , intent(in), optional :: STflds ! input state fields character(len=*) , intent(in), optional :: name ! name to use for output field bundle integer , intent(out) :: rc ! local variables - integer :: n,n1 + integer :: n integer :: fieldCount,fieldCountgeom character(ESMF_MAXSTR) :: lname type(ESMF_Field) :: field,lfield type(ESMF_Mesh) :: lmesh type(ESMF_MeshLoc) :: meshloc - integer :: ungriddedCount - integer :: ungriddedCount_in - integer, allocatable :: ungriddedLBound(:) - integer, allocatable :: ungriddedUBound(:) - logical :: isPresent - character(ESMF_MAXSTR), allocatable :: lfieldNameList(:) character(len=*), parameter :: subname='(med_methods_FB_init)' ! ---------------------------------------------- @@ -278,11 +274,6 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S ! verify that geom argument has a field !--------------------------------- - if (present(fieldNameList) .and. present(FBflds) .and. present(STflds)) then - call shr_log_error(trim(subname)//": ERROR only fieldNameList, FBflds, or STflds can be an argument", rc=rc) - return - endif - if (present(FBgeom) .and. present(STgeom)) then call shr_log_error(trim(subname)//": ERROR FBgeom and STgeom cannot both be arguments", rc=rc) return @@ -305,70 +296,12 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S endif !--------------------------------- - ! determine the names of fields that will be in FBout + ! Determine number of fields + ! + ! Note that scalars and blank fields will be removed later !--------------------------------- - if (present(fieldNameList)) then - fieldcount = size(fieldNameList) - allocate(lfieldNameList(fieldcount)) - lfieldNameList = fieldNameList - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from argument", ESMF_LOGMSG_INFO) - end if - elseif (present(FBflds)) then - call ESMF_FieldBundleGet(FBflds, fieldCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lfieldNameList(fieldCount)) - call ESMF_FieldBundleGet(FBflds, fieldNameList=lfieldNameList, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from FBflds", ESMF_LOGMSG_INFO) - end if - elseif (present(STflds)) then - call ESMF_StateGet(STflds, itemCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lfieldNameList(fieldCount)) - call ESMF_StateGet(STflds, itemNameList=lfieldNameList, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from STflds", ESMF_LOGMSG_INFO) - end if - elseif (present(FBgeom)) then - call ESMF_FieldBundleGet(FBgeom, fieldCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lfieldNameList(fieldCount)) - call ESMF_FieldBundleGet(FBgeom, fieldNameList=lfieldNameList, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from FBgeom", ESMF_LOGMSG_INFO) - end if - elseif (present(STgeom)) then - call ESMF_StateGet(STgeom, itemCount=fieldCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(lfieldNameList(fieldCount)) - call ESMF_StateGet(STgeom, itemNameList=lfieldNameList, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from STgeom", ESMF_LOGMSG_INFO) - end if - else - call shr_log_error(trim(subname)//": ERROR fieldNameList, FBflds, STflds, FBgeom, or STgeom must be passed", rc=rc) - return - endif - - !--------------------------------- - ! remove scalar field and blank fields from field bundle - !--------------------------------- - - do n = 1, fieldCount - if (trim(lfieldnamelist(n)) == trim(flds_scalar_name) .or. & - trim(lfieldnamelist(n)) == '') then - do n1 = n, fieldCount-1 - lfieldnamelist(n1) = lfieldnamelist(n1+1) - enddo - fieldCount = fieldCount - 1 - endif - enddo ! n + fieldCount = size(field_info_array) !--------------------------------- ! create the mesh(lmesh) that will be used for FBout fields @@ -426,61 +359,31 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S ! Now loop over all the fields in the field name list do n = 1, fieldCount - ! Note that input fields come from ONE of FBFlds, STflds, or fieldNamelist input argument - if (present(FBFlds) .or. present(STflds)) then - - ! ungridded dimensions might be present in the input states or field bundles - if (present(FBflds)) then - call ESMF_FieldBundleGet(FBflds, fieldName=lfieldnamelist(n), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - elseif (present(STflds)) then - call ESMF_StateGet(STflds, itemName=trim(lfieldnamelist(n)), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + ! Don't add scalar field or blank fields to field bundle + if (field_info_array(n)%name == flds_scalar_name .or. & + len_trim(field_info_array(n)%name) == 0) then + cycle + end if - ! Determine ungridded lower and upper bounds for lfield - call ESMF_AttributeGet(lfield, name="UngriddedUBound", convention="NUOPC", & - purpose="Instance", itemCount=ungriddedCount_in, isPresent=isPresent, rc=rc) + ! Create the field + if (field_info_array(n)%n_ungridded > 0) then + field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, & + name=field_info_array(n)%name, & + ungriddedLbound=field_info_array(n)%ungridded_lbound, & + ungriddedUbound=field_info_array(n)%ungridded_ubound, & + gridToFieldMap=[field_info_array(n)%n_ungridded+1], & + rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent) then - ungriddedCount = ungriddedCount_in - else - ungriddedCount=0 ! initialize in case it was not set - end if - - ! Create the field on a lmesh - if (ungriddedCount > 0) then - ! ungridded dimensions in field - allocate(ungriddedLBound(ungriddedCount), ungriddedUBound(ungriddedCount)) - call ESMF_AttributeGet(lfield, name="UngriddedLBound", convention="NUOPC", & - purpose="Instance", valueList=ungriddedLBound, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_AttributeGet(lfield, name="UngriddedUBound", convention="NUOPC", & - purpose="Instance", valueList=ungriddedUBound, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), & - ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, gridToFieldMap=(/2/)) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - deallocate( ungriddedLbound, ungriddedUbound) - else - ! No ungridded dimensions in field - field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - - else if (present(fieldNameList)) then - - ! Assume no ungridded dimensions if just the field name list is give - field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), rc=rc) + else + field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, & + name=field_info_array(n)%name, & + rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - ! Add the created field bundle FBout + ! Add the created field to field bundle FBout if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" adding field "//trim(lfieldNameList(n)), & + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" adding field "//trim(field_info_array(n)%name), & ESMF_LOGMSG_INFO) end if call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) @@ -489,8 +392,6 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S enddo ! fieldCount endif ! fieldcountgeom - deallocate(lfieldNameList) - call med_methods_FB_reset(FBout, value=spval_init, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 9417e2528..64de18785 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -31,6 +31,8 @@ module med_phases_aofluxes_mod use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : memcheck => med_memcheck use med_utils_mod , only : chkerr => med_utils_chkerr + use med_field_info_mod , only : med_field_info_type + use med_field_info_mod , only : med_field_info_array_from_names_wtracers, med_field_info_array_from_state use perf_mod , only : t_startf, t_stopf #ifndef CESMCOUPLED use ufs_const_mod , only : rearth => SHR_CONST_REARTH @@ -78,6 +80,7 @@ module med_phases_aofluxes_mod logical :: compute_atm_thbot integer :: ocn_surface_flux_scheme ! use case logical :: add_gusts + logical :: aofluxes_use_shr_wv_sat ! use shr_wv_sat_mod to calculate qsat for atm-ocn flux calculations character(len=CS), pointer :: fldnames_ocn_in(:) character(len=CS), pointer :: fldnames_atm_in(:) @@ -173,6 +176,7 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) integer :: fieldcount type(med_fldList_type), pointer :: fldListMed_aoflux type(InternalState) :: is_local + type(med_field_info_type), allocatable :: field_info_array(:) character(len=*),parameter :: subname=' (med_phases_aofluxes_init_fldbuns) ' !--------------------------------------- @@ -190,9 +194,16 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) call med_fldList_getfldnames(fldListMed_aoflux%fields, fldnames_aof_out, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Create field_info_array for FBMed_aoflux_a and FBMed_aoflux_o + call med_field_info_array_from_names_wtracers( & + field_names = fldnames_aof_out, & + field_info_array = field_info_array, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Initialize FBMed_aoflux_a call FB_init(is_local%wrap%FBMed_aoflux_a, is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compatm), fieldnamelist=fldnames_aof_out, name='FBMed_aoflux_a', rc=rc) + field_info_array=field_info_array, STgeom=is_local%wrap%NStateImp(compatm), name='FBMed_aoflux_a', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (maintask) then write(logunit,*) @@ -201,7 +212,7 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) ! Initialize FBMed_aoflux_o call FB_init(is_local%wrap%FBMed_aoflux_o, is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compocn), fieldnamelist=fldnames_aof_out, name='FBMed_aoflux_o', rc=rc) + field_info_array=field_info_array, STgeom=is_local%wrap%NStateImp(compocn), name='FBMed_aoflux_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (maintask) then write(logunit,'(a)') trim(subname)//' initialized FB FBMed_aoflux_o' @@ -219,8 +230,13 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) if (maintask) then write(logunit,'(a)') trim(subname)//' creating field bundle FBImp(compatm,compocn)' end if + call med_field_info_array_from_state( & + state = is_local%wrap%NStateImp(compatm), & + field_info_array = field_info_array, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_init(is_local%wrap%FBImp(compatm,compocn), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compocn), STflds=is_local%wrap%NStateImp(compatm), & + field_info_array=field_info_array, STgeom=is_local%wrap%NStateImp(compocn), & name='FBImp'//trim(compname(compatm))//'_'//trim(compname(compocn)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -234,8 +250,13 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) if (maintask) then write(logunit,'(a)') trim(subname)//' creating field bundle FBImp(compocn,compatm)' end if + call med_field_info_array_from_state( & + state = is_local%wrap%NStateImp(compocn), & + field_info_array = field_info_array, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_init(is_local%wrap%FBImp(compocn,compatm), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compatm), STflds=is_local%wrap%NStateImp(compocn), & + field_info_array = field_info_array, STgeom=is_local%wrap%NStateImp(compatm), & name='FBImp'//trim(compname(compocn))//'_'//trim(compname(compatm)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -399,6 +420,20 @@ subroutine med_aofluxes_init(gcomp, aoflux_in, aoflux_out, rc) add_gusts = .false. end if + call NUOPC_CompAttributeGet(gcomp, name='aofluxes_use_shr_wv_sat', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) aofluxes_use_shr_wv_sat + else + aofluxes_use_shr_wv_sat = .false. + end if +#ifdef CESMCOUPLED + if (maintask) then + write(logunit,*) + write(logunit,'(a,l7)') trim(subname)//' aofluxes_use_shr_wv_sat = ', aofluxes_use_shr_wv_sat + end if +#endif + ! 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 @@ -606,6 +641,7 @@ subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) integer :: maptype type(ESMF_Field) :: lfield type(ESMF_Mesh) :: lmesh + type(med_field_info_type), allocatable :: field_info_array(:) real(R8), pointer :: garea(:) => null() type(ESMF_CoordSys_Flag) :: coordSys character(len=*),parameter :: subname=' (med_aofluxes_init_atmgrid) ' @@ -623,8 +659,13 @@ subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) allocate(fldnames_ocn_in(4)) fldnames_ocn_in = (/'So_omask','So_t ','So_u ','So_v '/) + call med_field_info_array_from_names_wtracers( & + field_names = fldnames_ocn_in, & + field_info_array = field_info_array, & + rc = rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call FB_init(FBocn_a, is_local%wrap%flds_scalar_name, & - FBgeom=is_local%wrap%FBImp(compatm,compatm), fieldnamelist=fldnames_ocn_in, name='FBocn_a', rc=rc) + field_info_array=field_info_array, FBgeom=is_local%wrap%FBImp(compatm,compatm), name='FBocn_a', rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call set_aoflux_in_pointers(is_local%wrap%FBImp(compatm,compatm), FBocn_a, aoflux_in, lsize, rc=rc) @@ -1056,7 +1097,8 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) 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, & ocn_surface_flux_scheme=ocn_surface_flux_scheme, & - add_gusts=add_gusts, duu10n=aoflux_out%duu10n, ugust_out = aoflux_out%ugust_out, u10res = aoflux_out%u10res, & + add_gusts=add_gusts, aofluxes_use_shr_wv_sat=aofluxes_use_shr_wv_sat, & + duu10n=aoflux_out%duu10n, ugust_out = aoflux_out%ugust_out, u10res = aoflux_out%u10res, & ustar_sv=aoflux_out%ustar, re_sv=aoflux_out%re, ssq_sv=aoflux_out%ssq, missval=0.0_r8) #else diff --git a/mediator/med_phases_cdeps_mod.F90 b/mediator/med_phases_cdeps_mod.F90 index 4f37b6f79..9fe869bb2 100644 --- a/mediator/med_phases_cdeps_mod.F90 +++ b/mediator/med_phases_cdeps_mod.F90 @@ -20,7 +20,6 @@ module med_phases_cdeps_mod 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 diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 3cd0b4fb2..8530d5223 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -21,6 +21,7 @@ module med_phases_history_mod use med_internalstate_mod , only : ncomps, compname, compocn, complnd use med_internalstate_mod , only : InternalState, maintask, logunit use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close + use med_field_info_mod , only : med_field_info_type, med_field_info_array_from_state use perf_mod , only : t_startf, t_stopf use pio , only : file_desc_t use shr_log_mod , only : shr_log_error @@ -860,6 +861,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) ! local variables type(InternalState) :: is_local + type(med_field_info_type), allocatable :: field_info_array(:) character(CL) :: cvalue ! attribute string character(CL) :: hist_option ! freq_option setting (ndays, nsteps, etc) integer :: hist_n ! freq_n setting relative to freq_option @@ -924,8 +926,13 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) scalar_name = trim(is_local%wrap%flds_scalar_name) if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid)) .and. .not. & ESMF_FieldBundleIsCreated(avgfile%FBaccum_import)) then + call med_field_info_array_from_state( & + state = is_local%wrap%NStateImp(compid), & + field_info_array = field_info_array, & + rc = rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_init(avgfile%FBaccum_import, scalar_name, & - STgeom=is_local%wrap%NStateImp(compid), STflds=is_local%wrap%NStateImp(compid), rc=rc) + field_info_array=field_info_array, STgeom=is_local%wrap%NStateImp(compid), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_reset(avgfile%FBaccum_import, czero, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -933,8 +940,13 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) end if if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid)) .and. .not. & ESMF_FieldBundleIsCreated(avgfile%FBaccum_export)) then + call med_field_info_array_from_state( & + state = is_local%wrap%NStateExp(compid), & + field_info_array = field_info_array, & + rc = rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_init(avgfile%FBaccum_export, scalar_name, & - STgeom=is_local%wrap%NStateExp(compid), STflds=is_local%wrap%NStateExp(compid), rc=rc) + field_info_array=field_info_array, STgeom=is_local%wrap%NStateExp(compid), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_reset(avgfile%FBaccum_export, czero, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1067,6 +1079,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! local variables type(InternalState) :: is_local + type(med_field_info_type), allocatable :: field_info_array(:) type(ESMF_VM) :: vm type(ESMF_Calendar) :: calendar ! calendar type logical :: isPresent ! is attribute present @@ -1196,8 +1209,13 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) call ESMF_LogWrite(trim(subname)// ": initializing FBaccum(compid)", ESMF_LOGMSG_INFO) if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compid,compid)) .and. .not. & ESMF_FieldBundleIsCreated(auxcomp%files(nfcnt)%FBaccum)) then + call med_field_info_array_from_state( & + state = is_local%wrap%NStateImp(compid), & + field_info_array = field_info_array, & + rc = rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_init(auxcomp%files(nfcnt)%FBaccum, is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compid), STflds=is_local%wrap%NStateImp(compid), & + field_info_array=field_info_array, STgeom=is_local%wrap%NStateImp(compid), & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_reset(auxcomp%files(nfcnt)%FBaccum, czero, rc=rc) @@ -1786,7 +1804,7 @@ subroutine med_phases_history_set_timeinfo(gcomp, hclock, alarmname, & timediff(1) = nexttime - starttime - ringinterval call ESMF_TimeIntervalGet(timediff(2), d_r8=time_bnds(2), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeIntervalGet(timediff(1), d_r8=time_bnds(1), rc=rc) + call ESMF_TimeIntervalGet(timediff(1), startTimeIn=starttime, d_r8=time_bnds(1), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return time_val = 0.5_r8 * (time_bnds(1) + time_bnds(2)) else diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 9ca359610..f566382a9 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -38,6 +38,7 @@ module med_phases_prep_glc_mod use med_methods_mod , only : field_getdata2d => med_methods_Field_getdata2d use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d use med_methods_mod , only : fldchk => med_methods_FB_FldChk + use med_field_info_mod , only : med_field_info_type, med_field_info_array_from_state use med_utils_mod , only : chkerr => med_utils_ChkErr use nuopc_shr_methods , only : alarmInit use glc_elevclass_mod , only : glc_get_num_elevation_classes @@ -131,6 +132,7 @@ subroutine med_phases_prep_glc_init(gcomp, rc) ! local variables type(InternalState) :: is_local + type(med_field_info_type), allocatable :: field_info_array(:) integer :: n,ns,nf type(ESMF_Mesh) :: mesh_l type(ESMF_Mesh) :: mesh_o @@ -286,9 +288,13 @@ subroutine med_phases_prep_glc_init(gcomp, rc) ! Create route handle if it has not been created - this will be needed to map the fractions if (.not. med_map_RH_is_created(is_local%wrap%RH(compglc(ns),complnd,:),mapconsd, rc=rc)) then if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compglc(ns),complnd))) then + call med_field_info_array_from_state( & + state = is_local%wrap%NStateImp(compglc(ns)), & + field_info_array = field_info_array, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_init(is_local%wrap%FBImp(compglc(ns),complnd), is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(complnd), & - STflds=is_local%wrap%NStateImp(compglc(ns)), & + field_info_array=field_info_array, STgeom=is_local%wrap%NStateImp(complnd), & name='FBImp'//trim(compname(compglc(ns)))//'_'//trim(compname(complnd)), rc=rc) end if call med_map_routehandles_init( compglc(ns), complnd, & diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 1e028f877..c14657c51 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -21,6 +21,7 @@ module med_phases_prep_ocn_mod use med_methods_mod , only : FB_copy => med_methods_FB_copy 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 med_field_info_mod , only : med_field_info_type, med_field_info_array_from_state use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type use med_internalstate_mod , only : compocn, compatm, compice, coupling_mode use perf_mod , only : t_startf, t_stopf @@ -55,6 +56,7 @@ subroutine med_phases_prep_ocn_init(gcomp, rc) ! local variables type(InternalState) :: is_local + type(med_field_info_type), allocatable :: field_info_array(:) character(len=CL) :: cvalue logical :: isPresent, IsSet character(len=*),parameter :: subname=' (med_phases_prep_ocn_init) ' @@ -70,8 +72,13 @@ subroutine med_phases_prep_ocn_init(gcomp, rc) if (maintask) then write(logunit,'(a)') trim(subname)//' initializing ocean export accumulation FB for ' end if + call med_field_info_array_from_state( & + state = is_local%wrap%NStateExp(compocn), & + field_info_array = field_info_array, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_init(is_local%wrap%FBExpAccumOcn, is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateExp(compocn), STflds=is_local%wrap%NStateExp(compocn), & + field_info_array=field_info_array, STgeom=is_local%wrap%NStateExp(compocn), & name='FBExpAccumOcn', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_reset(is_local%wrap%FBExpAccumOcn, value=czero, rc=rc) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 1cfd158be..f732f4dc6 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -18,6 +18,7 @@ module med_phases_prep_wav_mod use med_methods_mod , only : FB_copy => med_methods_FB_copy 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 med_field_info_mod , only : med_field_info_type, med_field_info_array_from_state use esmFlds , only : med_fldList_GetfldListTo use med_internalstate_mod , only : compatm, compwav use perf_mod , only : t_startf, t_stopf @@ -47,6 +48,7 @@ subroutine med_phases_prep_wav_init(gcomp, rc) ! local variables type(InternalState) :: is_local + type(med_field_info_type), allocatable :: field_info_array(:) character(len=*),parameter :: subname=' (med_phases_prep_wav_init) ' !--------------------------------------- @@ -60,8 +62,13 @@ subroutine med_phases_prep_wav_init(gcomp, rc) if (maintask) then write(logunit,'(a)') trim(subname)//' initializing wave export accumulation FB for ' end if + call med_field_info_array_from_state( & + state = is_local%wrap%NStateExp(compwav), & + field_info_array = field_info_array, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_Init(is_local%wrap%FBExpAccumWav, is_local%wrap%flds_scalar_name, & - STgeom=is_local%wrap%NStateExp(compwav), STflds=is_local%wrap%NStateExp(compwav), & + field_info_array = field_info_array, STgeom=is_local%wrap%NStateExp(compwav), & name='FBExpAccumWav', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_reset(is_local%wrap%FBExpAccumWav, value=czero, rc=rc) diff --git a/ufs/CMakeLists.txt b/ufs/CMakeLists.txt index bb047dabb..19b34b5ae 100644 --- a/ufs/CMakeLists.txt +++ b/ufs/CMakeLists.txt @@ -1,6 +1,6 @@ project(CMEPS_share Fortran) include(ExternalProject) -add_library(cmeps_share flux_atmocn_mod.F90 glc_elevclass_mod.F90 perf_mod.F90 ufs_const_mod.F90 ufs_kind_mod.F90) +add_library(cmeps_share flux_atmocn_mod.F90 glc_elevclass_mod.F90 perf_mod.F90 ufs_const_mod.F90 ufs_kind_mod.F90 wtracers_mod.F90) target_include_directories (cmeps_share PUBLIC ${CMAKE_CURRENT_SOURCE_DIR} ${ESMF_F90COMPILEPATHS} ${PIO_Fortran_INCLUDE_DIRS}) diff --git a/ufs/wtracers_mod.F90 b/ufs/wtracers_mod.F90 new file mode 100644 index 000000000..17d2f3014 --- /dev/null +++ b/ufs/wtracers_mod.F90 @@ -0,0 +1,34 @@ +module wtracers_mod + + !----------------------------------------------------------------------------- + ! This module provides stub implementations for the shr_wtracers_mod code for when we + ! do not have access to the CESM_share library. + ! + ! See also the version of wtracers_mod in the cesm directory for when we have access to + ! the CESM_share library. + !----------------------------------------------------------------------------- + + implicit none + private + + public :: wtracers_is_wtracer_field ! return true if the given field name is a water tracer field + +contains + + !----------------------------------------------------------------------- + function wtracers_is_wtracer_field(fieldname) + ! + ! !DESCRIPTION: + ! Return true if the given field name is a water tracer field + ! + ! In this stub implementation, we always return false, since water tracers are not + ! implemented here. + ! + ! !ARGUMENTS + character(len=*), intent(in) :: fieldname + logical :: wtracers_is_wtracer_field + !----------------------------------------------------------------------- + wtracers_is_wtracer_field = .false. + end function wtracers_is_wtracer_field + +end module wtracers_mod