From 7419333c13c458191388001d973be470ded80fce Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Tue, 1 Feb 2022 11:35:23 -0500 Subject: [PATCH] Add Wave slow loop coupling and Field Exchanges for waves in nems (#266) Adds the ability to optionally place waves in the slow coupling loop. Also updates esmFldsExchange_nems to advertise and initialize required fields for the UFS S2SW application. Specific notes A FBExpAccumWav and counter are added. The prep_wav phase is split into prep_wav_accum and prep_wav_avg, replicating what is done for the the ocean component. For waves in the fast coupling loop, the current prep_wav phase in the run sequence should be replaced with prep_wav_accum followed by prep_wav_avg. Answers are B4B in UFS testing when compared to using the current prep_wav phase. For waves in the UFS S2SW application, the required fields are added to esmFldsExchange_nems. This requires a temporary conditional around the relevant code so that the S2SW app can continue to use NUOPC connectors during the transition to CMEPS. For the HAFS applications in UFS using both CMEPS and waves, the src and dst masking in med_map_mod are switched to conform with the usual interpretation of src and dst masking. Implementing this change for the HAFS wave coupled applications will ensure that no additional change to CMEPS will be required when HAFS is switched to the new WW3 cap. For continued use of the existing WW3 cap during the transition period, this requires the setting of these variables correctly for the wave model using nems.configure mask_value_water = 1 mask_value_land = 0 An extraneous ice->atm mapping in post_ice has also been removed and additional control of the dststatus_print is applied to prevent nonsensical files being produced. --- cime_config/runseq/runseq_general.py | 3 +- mediator/esmFldsExchange_hafs_mod.F90 | 4 +- mediator/esmFldsExchange_nems_mod.F90 | 75 +++++++++- mediator/med.F90 | 38 +++-- mediator/med_internalstate_mod.F90 | 6 +- mediator/med_map_mod.F90 | 81 ++++++----- mediator/med_phases_post_atm_mod.F90 | 18 ++- mediator/med_phases_post_ice_mod.F90 | 12 -- mediator/med_phases_post_ocn_mod.F90 | 15 +- mediator/med_phases_prep_ocn_mod.F90 | 1 - mediator/med_phases_prep_wav_mod.F90 | 197 +++++++++++++++++--------- mediator/med_phases_restart_mod.F90 | 19 ++- 12 files changed, 339 insertions(+), 130 deletions(-) diff --git a/cime_config/runseq/runseq_general.py b/cime_config/runseq/runseq_general.py index 7bfa3aaa6..2b7f0cc0a 100644 --- a/cime_config/runseq/runseq_general.py +++ b/cime_config/runseq/runseq_general.py @@ -110,7 +110,8 @@ def gen_runseq(case, coupling_times): runseq.add_action("MED med_phases_prep_ice" , med_to_ice) runseq.add_action("MED -> ICE :remapMethod=redist" , med_to_ice) - runseq.add_action("MED med_phases_prep_wav" , med_to_wav) + runseq.add_action("MED med_phases_prep_wav_accum" , med_to_wav) + runseq.add_action("MED med_phases_prep_wav_avg" , med_to_wav) runseq.add_action("MED -> WAV :remapMethod=redist" , med_to_wav) runseq.add_action("MED med_phases_prep_rof" , med_to_rof and not rof_outer_loop) diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index 605e8d080..bfa23dc25 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -172,7 +172,7 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%wav_present) then allocate(S_flds(1)) - S_flds = (/'Sw_zo'/) ! wave_z0_roughness_length + S_flds = (/'Sw_z0'/) ! wave_z0_roughness_length do n = 1,size(S_flds) fldname = trim(S_flds(n)) call addfld(fldListFr(compwav)%flds, trim(fldname)) @@ -385,7 +385,7 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) ! --------------------------------------------------------------------- if (hafs_attr%atm_present .and. hafs_attr%wav_present) then allocate(S_flds(1)) - S_flds = (/'Sw_zo'/) ! wave_z0_roughness_length + 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. & diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index f9a24166e..81def7650 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -24,8 +24,9 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use NUOPC use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_utils_mod , only : chkerr => med_utils_chkerr + use med_internalstate_mod , only : InternalState use med_internalstate_mod , only : mastertask, logunit - use med_internalstate_mod , only : compmed, compatm, compocn, compice, comprof, ncomps + use med_internalstate_mod , only : compmed, compatm, compocn, compice, comprof, compwav, ncomps use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf use med_internalstate_mod , only : mapconsf_aofrac @@ -42,6 +43,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) integer , intent(inout) :: rc ! local variables: + type(InternalState) :: is_local integer :: i, n, maptype character(len=CX) :: msgString character(len=CL) :: cvalue @@ -52,6 +54,10 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) rc = ESMF_SUCCESS + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Set maptype according to coupling_mode if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_orig_data') then maptype = mapnstod_consf @@ -159,6 +165,16 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) call addmap(fldListFr(compocn)%flds, 'So_t', compatm, maptype, 'ofrac', 'unset') call addmrg(fldListTo(compatm)%flds, 'So_t', mrg_from=compocn, mrg_fld='So_t', mrg_type='copy') + ! temporary conditional to avoid conflicts of advertised fields + ! when waves are passing through connectors + if (is_local%wrap%comp_present(compwav)) then + ! to atm: surface roughness length from wav + call addfld(fldListFr(compwav)%flds, 'Sw_z0') + call addfld(fldListTo(compatm)%flds, 'Sw_z0') + call addmap(fldListFr(compwav)%flds, 'Sw_z0', compatm, mapnstod_consf, 'one', 'unset') + call addmrg(fldListTo(compatm)%flds, 'Sw_z0', mrg_from=compwav, mrg_fld='Sw_z0', mrg_type='copy') + end if + !===================================================================== ! FIELDS TO OCEAN (compocn) !===================================================================== @@ -291,6 +307,23 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end do deallocate(flds) + ! temporary conditional to avoid conflicts of advertised fields + ! when waves are passing through connectors + if (is_local%wrap%comp_present(compwav)) then + ! to ocn: partitioned stokes drift from wav + allocate(flds(6)) + flds = (/'Sw_ustokes1', 'Sw_ustokes2', 'Sw_ustokes3', & + 'Sw_vstokes1', 'Sw_vstokes2', 'Sw_vstokes3'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + call addfld(fldListTo(compocn)%flds, trim(fldname)) + call addfld(fldListFr(compwav)%flds, trim(fldname)) + call addmap(fldListFr(compwav)%flds, trim(fldname), compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, trim(fldname), mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') + end do + deallocate(flds) + end if + !===================================================================== ! FIELDS TO ICE (compice) !===================================================================== @@ -353,6 +386,46 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end do deallocate(flds) + !===================================================================== + ! FIELDS TO WAV (compwav) + !===================================================================== + + ! temporary conditional to avoid conflicts of advertised fields + ! when waves are passing through connectors + if (is_local%wrap%comp_present(compwav)) then + ! to wav - 10m winds and bottom temperature from atm + allocate(flds(3)) + flds = (/'Sa_u10m', 'Sa_v10m', 'Sa_tbot'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compwav)%flds, trim(fldname)) + call addmap(fldListFr(compatm)%flds, trim(fldname), compwav, mapnstod_consf, 'one', 'unset') + call addmrg(fldListTo(compwav)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + end do + deallocate(flds) + + ! to wav: sea ice fraction + call addfld(fldListTo(compwav)%flds, 'Si_ifrac') + call addfld(fldListFr(compice)%flds, 'Si_ifrac') + call addmap(fldListFr(compice)%flds, 'Si_ifrac', compwav, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compwav)%flds, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy') + + ! to wav: zonal sea water velocity from ocn + ! to wav: meridional sea water velocity from ocn + ! to wav: surface temperature from ocn + allocate(flds(3)) + flds = (/'So_u', 'So_v', 'So_t'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + call addfld(fldListTo(compwav)%flds, trim(fldname)) + call addfld(fldListFr(compocn)%flds, trim(fldname)) + call addmap(fldListFr(compocn)%flds, trim(fldname), compwav, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compwav)%flds, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + end do + deallocate(flds) + end if + end subroutine esmFldsExchange_nems end module esmFldsExchange_nems_mod diff --git a/mediator/med.F90 b/mediator/med.F90 index d49255ef1..4ac79c4cf 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -101,7 +101,8 @@ subroutine SetServices(gcomp, rc) use med_phases_prep_atm_mod , only: med_phases_prep_atm use med_phases_prep_ice_mod , only: med_phases_prep_ice use med_phases_prep_lnd_mod , only: med_phases_prep_lnd - use med_phases_prep_wav_mod , only: med_phases_prep_wav + use med_phases_prep_wav_mod , only: med_phases_prep_wav_accum + use med_phases_prep_wav_mod , only: med_phases_prep_wav_avg use med_phases_prep_glc_mod , only: med_phases_prep_glc use med_phases_prep_rof_mod , only: med_phases_prep_rof use med_phases_prep_ocn_mod , only: med_phases_prep_ocn_accum @@ -343,10 +344,20 @@ subroutine SetServices(gcomp, rc) !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_phases_prep_wav"/), userRoutine=mediator_routine_Run, rc=rc) + phaseLabelList=(/"med_phases_prep_wav_accum"/), 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_prep_wav", specRoutine=med_phases_prep_wav, rc=rc) + specPhaseLabel="med_phases_prep_wav_accum", specRoutine=med_phases_prep_wav_accum, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_TimestampExport, & + specPhaselabel="med_phases_prep_wav_accum", specRoutine=NUOPC_NoOp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & + phaseLabelList=(/"med_phases_prep_wav_avg"/), 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_prep_wav_avg", specRoutine=med_phases_prep_wav_avg, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & @@ -638,7 +649,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) ! TransferOfferGeomObject Attribute. use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_SUCCESS, ESMF_LogFoundAllocError - use ESMF , only : ESMF_StateIsCreated + use ESMF , only : ESMF_StateIsCreated use ESMF , only : ESMF_LogMsg_Info, ESMF_LogWrite use ESMF , only : ESMF_END_ABORT, ESMF_Finalize, ESMF_MAXSTR use NUOPC , only : NUOPC_AddNamespace, NUOPC_Advertise, NUOPC_AddNestedState @@ -1498,6 +1509,7 @@ subroutine DataInitialize(gcomp, rc) use med_fraction_mod , only : med_fraction_init, med_fraction_set use med_phases_restart_mod , only : med_phases_restart_read use med_phases_prep_ocn_mod , only : med_phases_prep_ocn_init + use med_phases_prep_wav_mod , only : med_phases_prep_wav_init use med_phases_prep_rof_mod , only : med_phases_prep_rof_init use med_phases_prep_glc_mod , only : med_phases_prep_glc_init use med_phases_prep_atm_mod , only : med_phases_prep_atm @@ -1784,6 +1796,16 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + !--------------------------------------- + ! Initialize wav export accumulation field bundle + !--------------------------------------- + if ( is_local%wrap%comp_present(compwav) .and. & + ESMF_StateIsCreated(is_local%wrap%NStateImp(compwav),rc=rc) .and. & + ESMF_StateIsCreated(is_local%wrap%NStateExp(compwav),rc=rc)) then + call med_phases_prep_wav_init(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + !--------------------------------------- ! Initialize glc module field bundles here if appropriate !--------------------------------------- @@ -2059,12 +2081,12 @@ subroutine DataInitialize(gcomp, rc) ! Call post routines as part of initialization !--------------------------------------- if (is_local%wrap%comp_present(compatm)) then - ! map atm->ocn, atm->ice, atm->lnd + ! map atm->ocn, atm->ice, atm->lnd, atm->wav call med_phases_post_atm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (is_local%wrap%comp_present(compice)) then - ! call set ice_frac and map ice->atm and ice->ocn + ! call set ice_frac and map ice->ocn and ice->wav call med_phases_post_ice(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -2079,7 +2101,7 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (is_local%wrap%comp_present(compocn)) then - ! map initial ocn->ice + ! map initial ocn->ice, ocn->wav call med_phases_post_ocn(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -2089,7 +2111,7 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (is_local%wrap%comp_present(compwav)) then - ! map initial wav->ocn and wav->ice + ! map initial wav->ocn, wav->ice, wav->atm call med_phases_post_wav(gcomp, 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 0ae5dcaf0..8286118a9 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -163,8 +163,10 @@ module med_internalstate_mod type(ESMF_FieldBundle), pointer :: FBfrac(:) ! Fraction data for various components, on their grid ! Accumulators for export field bundles - type(ESMF_FieldBundle) :: FBExpAccumOcn ! Accumulator for various components export on their grid - integer :: ExpAccumOcnCnt = 0 ! Accumulator counter for each FBExpAccum + type(ESMF_FieldBundle) :: FBExpAccumOcn ! Accumulator for Ocn export on Ocn grid + integer :: ExpAccumOcnCnt = 0 ! Accumulator counter for FBExpAccumOcn + type(ESMF_FieldBundle) :: FBExpAccumWav ! Accumulator for Wav export on Wav grid + integer :: ExpAccumWavCnt = 0 ! Accumulator counter for FBExpAccumWav ! Component Mesh info type(mesh_info_type) , pointer :: mesh_info(:) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 628ddc7aa..5921d927e 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -365,7 +365,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, integer :: srcMaskValue integer :: dstMaskValue character(len=ESMF_MAXSTR) :: lmapfile - logical :: rhprint = .false. + logical :: rhprint = .false., ldstprint = .false. integer :: ns integer(I4), pointer :: dof(:) integer :: srcTermProcessing_Value = 0 @@ -386,6 +386,8 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, if (chkerr(rc,__LINE__,u_FILE_u)) return dststatusfield = ESMF_FieldCreate(dstmesh, ESMF_TYPEKIND_I4, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! set local flag to false + ldstprint = .false. polemethod=ESMF_POLEMETHOD_ALLAVG if (trim(coupling_mode) == 'cesm') then @@ -401,18 +403,19 @@ 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 else if (coupling_mode(1:4) == 'nems') then - if (n1 == compatm .and. (n2 == compocn .or. n2 == compice)) then + if ( (n1 == compocn .or. n1 == compice .or. n1 == compwav) .and. & + (n2 == compocn .or. n2 == compice .or. n2 == compwav) ) then + srcMaskValue = 0 + dstMaskValue = 0 + else if (n1 == compatm .and. (n2 == compocn .or. n2 == compice .or. n2 == compwav)) then srcMaskValue = 1 dstMaskValue = 0 if (atm_name(1:4).eq.'datm') then - srcMaskValue = 0 + srcMaskValue = 0 endif - else if (n2 == compatm .and. (n1 == compocn .or. n1 == compice)) then + else if (n2 == compatm .and. (n1 == compocn .or. n1 == compice .or. n1 == compwav)) then srcMaskValue = 0 dstMaskValue = 1 - else if ((n1 == compocn .and. n2 == compice) .or. (n1 == compice .and. n2 == compocn)) then - srcMaskValue = 0 - dstMaskValue = 0 else ! TODO: what should the condition be here? dstMaskValue = ispval_mask @@ -432,14 +435,16 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, srcMaskValue = 0 dstMaskValue = ispval_mask elseif (n1 == compatm .and. n2 == compwav) then - dstMaskValue = 1 + dstMaskValue = 0 elseif (n1 == compwav .and. n2 == compatm) then - srcMaskValue = 1 + srcMaskValue = 0 dstMaskValue = ispval_mask endif end if - write(string,'(a)') trim(compname(n1))//' to '//trim(compname(n2)) + write(string,'(a,i10,a,i10)') trim(compname(n1))//' to '//trim(compname(n2))//' srcMask = ', & + srcMaskValue,' dstMask = ',dstMaskValue + call ESMF_LogWrite(trim(string), ESMF_LOGMSG_INFO) ! Create route handle if (mapindex == mapfcopy) then @@ -473,6 +478,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, dstStatusField=dststatusfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ldstprint = .true. end if else if (mapindex == mapfillv_bilnr) then if (mastertask) then @@ -488,6 +494,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, dstStatusField=dststatusfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ldstprint = .true. else if (mapindex == mapbilnr_nstod) then if (mastertask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) @@ -503,6 +510,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, dstStatusField=dststatusfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ldstprint = .true. else if (mapindex == mapconsf .or. mapindex == mapnstod_consf) then if (mastertask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) @@ -518,6 +526,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ldstprint = .true. else if (mapindex == mapconsf_aofrac) then if (.not. ESMF_RouteHandleIsCreated(routehandles(mapconsf))) then if (mastertask) then @@ -534,6 +543,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ldstprint = .true. else ! Copy existing consf RH if (mastertask) then @@ -557,6 +567,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ldstprint = .true. else if (mapindex == mappatch .or. mapindex == mappatch_uv3d) then if (.not. ESMF_RouteHandleIsCreated(routehandles(mappatch))) then if (mastertask) then @@ -572,6 +583,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, dstStatusField=dststatusfield, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ldstprint = .true. end if else if (mastertask) then @@ -584,30 +596,28 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, end if ! Output destination status field to file if requested - if (dststatus_print) then - if (mapindex /= mapfcopy .or. lmapfile /= 'unset') then - fname = 'dststatus.'//trim(compname(n1))//'.'//trim(compname(n2))//'.'//trim(mapname)//'.nc' - call ESMF_LogWrite(trim(subname)//": writing dstStatusField to "//trim(fname), ESMF_LOGMSG_INFO) - - call ESMF_FieldWrite(dststatusfield, filename=trim(fname), variableName='dststatus', & - overwrite=.true., rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! the sequence index in order to sort the dststatus field - call ESMF_MeshGet(dstmesh, elementDistgrid=distgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(dof(ns)) - call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - doffield = ESMF_FieldCreate(dstmesh, dof, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldWrite(doffield, fileName='dof.'//trim(compname(n2))//'.nc', variableName='dof', & - overwrite=.true., rc=rc) - deallocate(dof) - call ESMF_FieldDestroy(doffield, rc=rc, noGarbage=.true.) - end if + if (dststatus_print .and. ldstprint) then + fname = 'dststatus.'//trim(compname(n1))//'.'//trim(compname(n2))//'.'//trim(mapname)//'.nc' + call ESMF_LogWrite(trim(subname)//": writing dstStatusField to "//trim(fname), ESMF_LOGMSG_INFO) + + call ESMF_FieldWrite(dststatusfield, filename=trim(fname), variableName='dststatus', & + overwrite=.true., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! the sequence index in order to sort the dststatus field + call ESMF_MeshGet(dstmesh, elementDistgrid=distgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(dof(ns)) + call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + doffield = ESMF_FieldCreate(dstmesh, dof, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldWrite(doffield, fileName='dof.'//trim(compname(n2))//'.nc', variableName='dof', & + overwrite=.true., rc=rc) + deallocate(dof) + call ESMF_FieldDestroy(doffield, rc=rc, noGarbage=.true.) end if ! consd_nstod method requires a second routehandle @@ -622,9 +632,10 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ldstprint = .true. ! Output destination status field to file if requested - if (dststatus_print) then + if (dststatus_print .and. ldstprint) then fname = 'dststatus.'//trim(compname(n1))//'.'//trim(compname(n2))//'.'//trim(mapname)//'_2.nc' call ESMF_LogWrite(trim(subname)//": writing dstStatusField to "//trim(fname), ESMF_LOGMSG_INFO) diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index 8f528becc..ab6f65e2b 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -1,7 +1,8 @@ module med_phases_post_atm_mod !----------------------------------------------------------------------------- - ! Mediator phase for post atm calculations, maps atm->ice, atm->lnd and atm->ocn + ! Mediator phase for post atm calculations, maps atm->ice, atm->lnd, atm->ocn + ! and atm->wav !----------------------------------------------------------------------------- implicit none @@ -32,7 +33,7 @@ subroutine med_phases_post_atm(gcomp, rc) use med_map_mod , only : med_map_field_packed use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_internalstate_mod , only : compocn, compatm, compice, complnd + use med_internalstate_mod , only : compocn, compatm, compice, complnd, compwav use perf_mod , only : t_startf, t_stopf ! input/output variables @@ -96,6 +97,19 @@ subroutine med_phases_post_atm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf('MED:'//trim(subname)//' map_atm2lnd') end if + ! map atm->wav + if (is_local%wrap%med_coupling_active(compatm,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), & + 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') + end if ! Write atm inst, avg or aux if requested in mediator attributes call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) diff --git a/mediator/med_phases_post_ice_mod.F90 b/mediator/med_phases_post_ice_mod.F90 index 637cd2917..d081448e4 100644 --- a/mediator/med_phases_post_ice_mod.F90 +++ b/mediator/med_phases_post_ice_mod.F90 @@ -59,18 +59,6 @@ subroutine med_phases_post_ice(gcomp, rc) call med_fraction_set(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! map ice to atm - scaling by updated ice fraction - if (is_local%wrap%med_coupling_active(compice,compatm)) then - call med_map_field_packed( & - FBSrc=is_local%wrap%FBImp(compice,compice), & - FBDst=is_local%wrap%FBImp(compice,compatm), & - FBFracSrc=is_local%wrap%FBFrac(compice), & - field_NormOne=is_local%wrap%field_normOne(compice,compatm,:), & - packed_data=is_local%wrap%packed_data(compice,compatm,:), & - routehandles=is_local%wrap%RH(compice,compatm,:), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - end if ! map ice to ocn if (is_local%wrap%med_coupling_active(compice,compocn)) then call t_startf('MED:'//trim(subname)//' map_ice2ocn') diff --git a/mediator/med_phases_post_ocn_mod.F90 b/mediator/med_phases_post_ocn_mod.F90 index 5f72cc5ea..abf766211 100644 --- a/mediator/med_phases_post_ocn_mod.F90 +++ b/mediator/med_phases_post_ocn_mod.F90 @@ -27,7 +27,7 @@ subroutine med_phases_post_ocn(gcomp, rc) use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, logunit, mastertask - use med_internalstate_mod , only : compice, compocn + use med_internalstate_mod , only : compice, compocn, compwav use med_phases_history_mod , only : med_phases_history_write_comp use med_phases_prep_glc_mod , only : med_phases_prep_glc_accum_ocn use perf_mod , only : t_startf, t_stopf @@ -67,6 +67,19 @@ subroutine med_phases_post_ocn(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf('MED:'//trim(subname)//' map_ocn2ice') end if + ! Map ocn->wav + if (is_local%wrap%med_coupling_active(compocn,compwav)) then + call t_startf('MED:'//trim(subname)//' map_ocn2wav') + call med_map_field_packed( & + FBSrc=is_local%wrap%FBImp(compocn,compocn), & + FBDst=is_local%wrap%FBImp(compocn,compwav), & + FBFracSrc=is_local%wrap%FBFrac(compocn), & + field_normOne=is_local%wrap%field_normOne(compocn,compwav,:), & + packed_data=is_local%wrap%packed_data(compocn,compwav,:), & + routehandles=is_local%wrap%RH(compocn,compwav,:), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('MED:'//trim(subname)//' map_ocn2wav') + end if ! Accumulate ocn input for glc if there is ocn->glc coupling if (is_local%wrap%ocn2glc_coupling) then diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 611f42879..0858462bc 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -44,7 +44,6 @@ subroutine med_phases_prep_ocn_init(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_SUCCESS use med_methods_mod , only : FB_Init => med_methods_FB_init - use med_methods_mod , only : FB_Reset => med_methods_FB_Reset ! input/output variables type(ESMF_GridComp) :: gcomp diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index ba3d710d8..a1bd85c1b 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -5,20 +5,28 @@ module med_phases_prep_wav_mod !----------------------------------------------------------------------------- use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use med_constants_mod , only : czero =>med_constants_czero + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_merge_mod , only : med_merge_auto, med_merge_field + use med_map_mod , only : med_map_field_packed + use med_utils_mod , only : memcheck => med_memcheck use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose - use med_merge_mod , only : med_merge_auto - use med_map_mod , only : med_map_field_packed - use med_internalstate_mod , only : InternalState, mastertask - use med_internalstate_mod , only : compwav, ncomps, compname - use esmFlds , only : fldListFr, fldListTo + use med_methods_mod , only : FB_accum => med_methods_FB_accum + use med_methods_mod , only : FB_average => med_methods_FB_average + use med_methods_mod , only : FB_copy => med_methods_FB_copy + use med_methods_mod , only : FB_reset => med_methods_FB_reset + use esmFlds , only : fldListTo + use med_internalstate_mod , only : compwav use perf_mod , only : t_startf, t_stopf implicit none private - public :: med_phases_prep_wav + public :: med_phases_prep_wav_init ! called from med.F90 + public :: med_phases_prep_wav_accum ! called from run sequence + public :: med_phases_prep_wav_avg ! called from run sequence character(*), parameter :: u_FILE_u = & __FILE__ @@ -27,12 +35,45 @@ module med_phases_prep_wav_mod contains !----------------------------------------------------------------------------- - subroutine med_phases_prep_wav(gcomp, rc) + subroutine med_phases_prep_wav_init(gcomp, rc) + + use ESMF , only : ESMF_GridComp, ESMF_SUCCESS + use med_methods_mod , only : FB_Init => med_methods_FB_init + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + character(len=*),parameter :: subname=' (med_phases_prep_wav_init) ' + !--------------------------------------- + + rc = ESMF_SUCCESS + + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + + if (mastertask) then + write(logunit,'(a)') trim(subname)//' initializing wave export accumulation FB for ' + end if + 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), & + name='FBExpAccumWav', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_reset(is_local%wrap%FBExpAccumWav, value=czero, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine med_phases_prep_wav_init + + !----------------------------------------------------------------------------- + subroutine med_phases_prep_wav_accum(gcomp, rc) + + use ESMF , only : ESMF_GridComp, ESMF_FieldBundleGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time - use ESMF , only : ESMF_GridCompGet, ESMF_FieldBundleGet, ESMF_ClockGet, ESMF_TimeGet - use ESMF , only : ESMF_ClockPrint + use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR ! input/output variables type(ESMF_GridComp) :: gcomp @@ -40,85 +81,113 @@ subroutine med_phases_prep_wav(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: i,j,n,n1,ncnt - character(len=*),parameter :: subname='(med_phases_prep_wav)' + integer :: n, ncnt + character(len=*), parameter :: subname='(med_phases_prep_wav_accum)' !--------------------------------------- call t_startf('MED:'//subname) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + if (dbug_flag > 20) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) end if rc = ESMF_SUCCESS + call memcheck(subname, 5, mastertask) + ! Get the internal state + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! auto merges to wav + call med_merge_auto(& + is_local%wrap%med_coupling_active(:,compwav), & + is_local%wrap%FBExp(compwav), & + is_local%wrap%FBFrac(compwav), & + is_local%wrap%FBImp(:,compwav), & + fldListTo(compwav), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! wave accumulator + call FB_accum(is_local%wrap%FBExpAccumWav, is_local%wrap%FBExp(compwav), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + is_local%wrap%ExpAccumWavCnt = is_local%wrap%ExpAccumWavCnt + 1 + + ! diagnose output + if (dbug_flag > 1) then + call FB_diagnose(is_local%wrap%FBExpAccumWav, string=trim(subname)//' FBExpAccumWav accumulation ', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + end if + call t_stopf('MED:'//subname) + + end subroutine med_phases_prep_wav_accum + + !----------------------------------------------------------------------------- + subroutine med_phases_prep_wav_avg(gcomp, rc) + + ! Prepare the wav import Fields. + + use ESMF , only : ESMF_GridComp, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FieldBundleGet + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: ncnt + character(len=*),parameter :: subname='(med_phases_prep_wav_avg)' !--------------------------------------- - ! --- Get the internal state - !--------------------------------------- + rc = ESMF_SUCCESS + + call t_startf('MED:'//subname) + if (dbug_flag > 20) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + + ! Get the internal state nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Count the number of fields outside of scalar data, if zero, then return - ! Note - the scalar field has been removed from all mediator field bundles - so this is why we check if the - ! fieldCount is 0 and not 1 here - call ESMF_FieldBundleGet(is_local%wrap%FBExp(compwav), fieldCount=ncnt, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBExpAccumWav, fieldCount=ncnt, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if (ncnt > 0) then - ! map to create FBimp(:,compwav) - do n1 = 1,ncomps - if (is_local%wrap%med_coupling_active(n1,compwav)) then - call med_map_field_packed( & - FBSrc=is_local%wrap%FBImp(n1,n1), & - FBDst=is_local%wrap%FBImp(n1,compwav), & - FBFracSrc=is_local%wrap%FBFrac(n1), & - field_normOne=is_local%wrap%field_normOne(n1,compwav,:), & - packed_data=is_local%wrap%packed_data(n1,compwav,:), & - routehandles=is_local%wrap%RH(n1,compwav,:), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do - - ! auto merges to create FBExp(compwav) - call med_merge_auto(& - is_local%wrap%med_coupling_active(:,compwav), & - is_local%wrap%FBExp(compwav), & - is_local%wrap%FBFrac(compwav), & - is_local%wrap%FBImp(:,compwav), & - fldListTo(compwav), rc=rc) + ! average wav accumulator + if (dbug_flag > 1) then + call FB_diagnose(is_local%wrap%FBExpAccumWav, & + string=trim(subname)//' FBExpAccumWav before avg ', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call FB_average(is_local%wrap%FBExpAccumWav, is_local%wrap%ExpAccumWavCnt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !--------------------------------------- - !--- diagnose output - !--------------------------------------- - if (dbug_flag > 1) then - call FB_diagnose(is_local%wrap%FBExp(compwav), & - string=trim(subname)//' FBexp(compwav) ', rc=rc) + call FB_diagnose(is_local%wrap%FBExpAccumWav, & + string=trim(subname)//' FBExpAccumWav after avg ', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - !--------------------------------------- - !--- custom calculations - !--------------------------------------- - - !--------------------------------------- - !--- update local scalar data - !--------------------------------------- - - !is_local%wrap%scalar_data(1) = + ! copy to FBExp(compwav) + call FB_copy(is_local%wrap%FBExp(compwav), is_local%wrap%FBExpAccumWav, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - !--------------------------------------- - !--- clean up - !--------------------------------------- + ! zero accumulator + is_local%wrap%ExpAccumWavCnt = 0 + call FB_reset(is_local%wrap%FBExpAccumWav, value=czero, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - endif + end if - if (dbug_flag > 5) then + if (dbug_flag > 20) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if call t_stopf('MED:'//subname) - end subroutine med_phases_prep_wav - + end subroutine med_phases_prep_wav_avg end module med_phases_prep_wav_mod diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index fc202a570..5affb149a 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -8,7 +8,7 @@ module med_phases_restart_mod use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : chkerr => med_utils_ChkErr use med_internalstate_mod , only : mastertask, logunit, InternalState - use med_internalstate_mod , only : ncomps, compname, compocn, complnd + use med_internalstate_mod , only : ncomps, compname, compocn, complnd, compwav use perf_mod , only : t_startf, t_stopf use med_phases_prep_glc_mod , only : FBlndAccum2glc_l, lndAccum2glc_cnt use med_phases_prep_glc_mod , only : FBocnAccum2glc_o, ocnAccum2glc_cnt @@ -381,6 +381,17 @@ subroutine med_phases_restart_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif + ! Write export accumulation to wav + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccumWav)) then + nx = is_local%wrap%nx(compwav) + ny = is_local%wrap%ny(compwav) + call med_io_write(restart_file, is_local%wrap%FBExpAccumWav, whead(m), wdata(m), nx, ny, & + nt=1, pre='wavExpAccum', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_write(restart_file, is_local%wrap%ExpAccumWavCnt, 'wavExpAccum_cnt', whead(m), wdata(m), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + ! Write accumulation from lnd to rof if lnd->rof coupling is on if (ESMF_FieldBundleIsCreated(FBlndAccum2rof_l)) then nx = is_local%wrap%nx(complnd) @@ -584,6 +595,12 @@ subroutine med_phases_restart_read(gcomp, rc) call med_io_read(restart_file, vm, is_local%wrap%ExpAccumOcnCnt, 'ocnExpAccum_cnt', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccumWav,rc=rc)) then + call med_io_read(restart_file, vm, is_local%wrap%FBExpAccumWav, pre='wavExpAccum', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_read(restart_file, vm, is_local%wrap%ExpAccumWavCnt, 'wavExpAccum_cnt', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif ! If lnd->rof, read accumulation from lnd to rof (CESM only) if (ESMF_FieldBundleIsCreated(FBlndAccum2rof_l)) then call med_io_read(restart_file, vm, FBlndAccum2rof_l, pre='lndImpAccum2rof', rc=rc)