diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index e853d7073..2bb45a90d 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -77,7 +77,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) use esmflds , only : compmed, compatm, complnd, compocn use esmflds , only : compice, comprof, compwav, ncomps use esmflds , only : compglc, num_icesheets, ocn2glc_coupling ! compglc is an array of integers - use esmflds , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d + use esmflds , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d, mapbilnr_nstod use esmflds , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf use esmflds , only : map_glc2ocn_ice, map_glc2ocn_liq, map_rof2ocn_ice, map_rof2ocn_liq use esmflds , only : fldListTo, fldListFr, fldListMed_aoflux, fldListMed_ocnalb @@ -2228,7 +2228,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_lamult', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_lamult', rc=rc)) then - call addmap(fldListFr(compwav)%flds, 'Sw_lamult', compocn, mapbilnr, 'one', wav2ocn_smap) + call addmap(fldListFr(compwav)%flds, 'Sw_lamult', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) call addmrg(fldListTo(compocn)%flds, 'Sw_lamult', mrg_from=compwav, mrg_fld='Sw_lamult', mrg_type='copy') end if end if @@ -2241,7 +2241,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_ustokes', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_ustokes', rc=rc)) then - call addmap(fldListFr(compwav)%flds, 'Sw_ustokes', compocn, mapbilnr, 'one', wav2ocn_smap) + call addmap(fldListFr(compwav)%flds, 'Sw_ustokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) call addmrg(fldListTo(compocn)%flds, 'Sw_ustokes', mrg_from=compwav, mrg_fld='Sw_ustokes', mrg_type='copy') end if end if @@ -2254,7 +2254,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_vstokes', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_vstokes', rc=rc)) then - call addmap(fldListFr(compwav)%flds, 'Sw_vstokes', compocn, mapbilnr, 'one', wav2ocn_smap) + call addmap(fldListFr(compwav)%flds, 'Sw_vstokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) call addmrg(fldListTo(compocn)%flds, 'Sw_vstokes', mrg_from=compwav, mrg_fld='Sw_vstokes', mrg_type='copy') end if end if @@ -2267,10 +2267,36 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_hstokes', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_hstokes', rc=rc)) then - call addmap(fldListFr(compwav)%flds, 'Sw_hstokes', compocn, mapbilnr, 'one', wav2ocn_smap) + call addmap(fldListFr(compwav)%flds, 'Sw_hstokes', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) call addmrg(fldListTo(compocn)%flds, 'Sw_hstokes', mrg_from=compwav, mrg_fld='Sw_hstokes', mrg_type='copy') end if end if + !----------------------------- + ! to ocn: Partitioned stokes drift components in x-direction + !----------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compwav)%flds, 'Sw_pstokes_x') + call addfld(fldListTo(compocn)%flds, 'Sw_pstokes_x') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_pstokes_x', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_pstokes_x', rc=rc)) then + call addmap(fldListFr(compwav)%flds, 'Sw_pstokes_x', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg(fldListTo(compocn)%flds, 'Sw_pstokes_x', mrg_from=compwav, mrg_fld='Sw_pstokes_x', mrg_type='copy') + end if + end if + !----------------------------- + ! to ocn: Stokes drift depth from wave + !----------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compwav)%flds, 'Sw_pstokes_y') + call addfld(fldListTo(compocn)%flds, 'Sw_pstokes_y') + else + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Sw_pstokes_y', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), 'Sw_pstokes_y', rc=rc)) then + call addmap(fldListFr(compwav)%flds, 'Sw_pstokes_y', compocn, mapbilnr_nstod, 'one', wav2ocn_smap) + call addmrg(fldListTo(compocn)%flds, 'Sw_pstokes_y', mrg_from=compwav, mrg_fld='Sw_pstokes_y', mrg_type='copy') + end if + end if !===================================================================== ! FIELDS TO ICE (compice) diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index b4a407a06..55da80619 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -1117,6 +1117,13 @@ canonical_units: m/s description: ocean import - Stokes drift v component # + - standard_name: Sw_pstokes_x + canonical_units: m/s + description: Eastward partitioned stokes drift components + # + - standard_name: Sw_pstokes_y + canonical_units: m/s + description: Northward partitioned stokes drift components #----------------------------------- # mediator fields #----------------------------------- diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index cc8e77181..debea58b0 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -325,7 +325,7 @@ end subroutine med_map_routehandles_initfrom_fieldbundle subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, routehandles, mapfile, rc) use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandlePrint, ESMF_Field, ESMF_MAXSTR - use ESMF , only : ESMF_PoleMethod_Flag, ESMF_POLEMETHOD_ALLAVG + use ESMF , only : ESMF_PoleMethod_Flag, ESMF_POLEMETHOD_ALLAVG, ESMF_POLEMETHOD_NONE use ESMF , only : ESMF_FieldSMMStore, ESMF_FieldRedistStore, ESMF_FieldRegridStore use ESMF , only : ESMF_RouteHandleIsCreated, ESMF_RouteHandleCreate use ESMF , only : ESMF_REGRIDMETHOD_BILINEAR, ESMF_REGRIDMETHOD_PATCH @@ -368,7 +368,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, integer :: ns integer(I4), pointer :: dof(:) => null() integer :: srcTermProcessing_Value = 0 - type(ESMF_PoleMethod_Flag), parameter :: polemethod=ESMF_POLEMETHOD_ALLAVG + type(ESMF_PoleMethod_Flag) :: polemethod character(len=*), parameter :: subname=' (module_med_map: med_map_routehandles_initfrom_field) ' !--------------------------------------------- @@ -386,11 +386,19 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, dststatusfield = ESMF_FieldCreate(dstmesh, ESMF_TYPEKIND_I4, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + polemethod=ESMF_POLEMETHOD_ALLAVG if (trim(coupling_mode) == 'cesm') then dstMaskValue = ispval_mask srcMaskValue = ispval_mask if (n1 == compocn .or. n1 == compice) srcMaskValue = 0 if (n2 == compocn .or. n2 == compice) dstMaskValue = 0 + if (n1 == compwav .and. n2 == compocn) then + srcMaskValue = 0 + dstMaskValue = ispval_mask + endif + if (n1 == compwav .or. n2 == compwav) then + 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 srcMaskValue = 1