Merge pull request ESCOMP#324 from DeniseWorthen/feature/updcmeps

update flds_exchange_nems for wave coupling changes ### Description of changes Changes mapping type for UFS between wave-ice-ocn to be bilinear with nstod fill. Adds optional wave-ice coupling for UFS. Minor trailing whitespace cleanup. ### Testing performed Testing performed if application target is CESM: - [ ] (recommended) CIME_DRIVER=nuopc scripts_regression_tests.py - machines: - details (e.g. failed tests): - [ ] (recommended) CESM testlist_drv.xml - machines and compilers: - details (e.g. failed tests): - [ ] (optional) CESM prealpha test - machines and compilers - details (e.g. failed tests): - [ ] (other) please described in detail - machines and compilers - details (e.g. failed tests): Testing performed if application target is UFS-coupled: - [X] (recommended) UFS-coupled testing - description: all tests are B4B against current develop branch - details (e.g. failed tests): Testing performed if application target is UFS-HAFS: - [X] (recommended) UFS-HAFS testing - description: all tests are B4B against current develop branch - details (e.g. failed tests): ### Hashes used for testing: - [ ] CESM: - repository to check out: https://github.com/ESCOMP/CESM.git - branch/hash: - [x] UFS-coupled, then umbrella repostiory to check out and associated hash: - repository to check out: https://github.com/ufs-community/ufs-weather-model - branch/hash: [3a8533c](ufs-community/ufs-weather-model@3a8533c) - [x] UFS-HAFS, then umbrella repostiory to check out and associated hash: - repository to check out: https://github.com/ufs-community/ufs-weather-model - branch/hash: [3a8533c](ufs-community/ufs-weather-model@3a8533c)
NorESMhub · Dec 5, 2022 · 91749fd · 91749fd
2 parents ae5cfcd + 28199a1
commit 91749fd
Show file tree

Hide file tree

Showing 6 changed files with 54 additions and 34 deletions.
diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90
@@ -301,7 +301,7 @@ subroutine med_fldList_AddMrg(flds, fldname, mrg_from, mrg_fld, mrg_type, mrg_fr
     ! ----------------------------------------------
 
     newfld => med_fldList_GetFld(flds, fldname, rc)
-    if (chkerr(rc,__LINE__,u_FILE_u)) return    
+    if (chkerr(rc,__LINE__,u_FILE_u)) return
     newfld%merge_fields(mrg_from) = mrg_fld
     newfld%merge_types(mrg_from) = mrg_type
     if (present(mrg_fracname)) then
@@ -346,7 +346,7 @@ end function med_fldList_GetFld
 
   subroutine med_fldList_addmap_from(index, fldname, destcomp, maptype, mapnorm, mapfile)
     integer, intent(in) :: index
-    character(len=*)                  , intent(in)    :: fldname    
+    character(len=*)                  , intent(in)    :: fldname
     integer                            , intent(in)    :: destcomp
     integer                            , intent(in)    :: maptype
     character(len=*)                   , intent(in)    :: mapnorm
@@ -359,7 +359,7 @@ end subroutine med_fldList_addmap_from
   !================================================================================
 
   subroutine med_fldList_addmap_aoflux(fldname, destcomp, maptype, mapnorm, mapfile)
-    character(len=*)                  , intent(in)    :: fldname    
+    character(len=*)                  , intent(in)    :: fldname
     integer                            , intent(in)    :: destcomp
     integer                            , intent(in)    :: maptype
     character(len=*)                   , intent(in)    :: mapnorm
@@ -372,7 +372,7 @@ end subroutine med_fldList_addmap_aoflux
   !================================================================================
 
   subroutine med_fldList_addmap_ocnalb(fldname, destcomp, maptype, mapnorm, mapfile)
-    character(len=*)                  , intent(in)    :: fldname    
+    character(len=*)                  , intent(in)    :: fldname
     integer                            , intent(in)    :: destcomp
     integer                            , intent(in)    :: maptype
     character(len=*)                   , intent(in)    :: mapnorm
@@ -390,7 +390,7 @@ subroutine med_fldList_AddMap(fields, fldname, destcomp, maptype, mapnorm, mapfi
 
     ! intput/output variables
     type(med_fldList_entry_type) , intent(in), target :: fields
-    character(len=*)                  , intent(in)    :: fldname    
+    character(len=*)                  , intent(in)    :: fldname
     integer                            , intent(in)    :: destcomp
     integer                            , intent(in)    :: maptype
     character(len=*)                   , intent(in)    :: mapnorm
@@ -406,7 +406,7 @@ subroutine med_fldList_AddMap(fields, fldname, destcomp, maptype, mapnorm, mapfi
     if (present(mapfile)) lmapfile = mapfile
 
     newfld => med_fldList_GetFld(fields, fldname, rc)
-    if (chkerr(rc,__LINE__,u_FILE_u)) return    
+    if (chkerr(rc,__LINE__,u_FILE_u)) return
     ! Note - default values are already set for the fld entries - so only non-default
     ! values need to be set below
     ! If mapindex is mapfcopy - create a redistribution route handle
@@ -704,7 +704,7 @@ subroutine med_fld_GetFldInfo(newfld, compsrc, stdname, shortname, mapindex, map
 
     ! local variables
     integer :: lrc
-    integer :: lcompsrc 
+    integer :: lcompsrc
     character(len=*), parameter :: subname='(med_fld_GetFldInfo)'
     lrc = ESMF_SUCCESS
 
@@ -851,7 +851,7 @@ subroutine med_fldList_Document_Mapping(logunit, med_coupling_active)
                 mapindex = newfld%mapindex(ndst)
                 if ( mapindex /= mapunset) then
                    call med_fld_GetFldInfo(newfld, compsrc=ndst, stdname=fldname, mapnorm=mapnorm, mapfile=mapfile, rc=rc)
-                   if (chkerr(rc,__LINE__,u_FILE_u)) return          
+                   if (chkerr(rc,__LINE__,u_FILE_u)) return
 
                    if (trim(mapnorm) == 'unset') then
                       cvalue = ' mapping '//trim(compname(nsrc))//'->'//trim(compname(ndst)) //' '//trim(fldname) // &
@@ -882,7 +882,7 @@ subroutine med_fldList_Document_Mapping(logunit, med_coupling_active)
           call med_fld_GetFldInfo(newfld, compsrc=ndst, mapindex=mapindex, rc=rc)
           if ( mapindex /= mapunset) then
              call med_fld_GetFldInfo(newfld, stdname=fldname, compsrc=ndst, mapnorm=mapnorm, mapfile=mapfile, rc=rc)
-             if (chkerr(rc,__LINE__,u_FILE_u)) return          
+             if (chkerr(rc,__LINE__,u_FILE_u)) return
 
              if (trim(mapnorm) == 'unset') then
                 cvalue = ' mapping '//trim(compname(nsrc))//'->'//trim(compname(ndst)) //' '//trim(fldname) // &
@@ -946,7 +946,7 @@ subroutine med_fldList_Document_Merging(logunit, med_coupling_active)
        newfld => fldListTo(ndst)%fields
        do while(associated(newfld))
           call med_fld_GetFldInfo(newfld, stdname=dst_field, rc=rc)
-          if (chkerr(rc,__LINE__,u_FILE_u)) return          
+          if (chkerr(rc,__LINE__,u_FILE_u)) return
 
           ! Loop over all possible source components for destination component field
           mrgstr = ' '
@@ -955,7 +955,7 @@ subroutine med_fldList_Document_Merging(logunit, med_coupling_active)
              if (nsrc /= ndst .and. med_coupling_active(nsrc,ndst)) then
                 src_comp    = compname(nsrc)
                 call med_fld_GetFldInfo(newfld, compsrc=nsrc, merge_fields=merge_field, merge_type=merge_type, merge_fracname=merge_frac, rc=rc)
-                if (chkerr(rc,__LINE__,u_FILE_u)) return          
+                if (chkerr(rc,__LINE__,u_FILE_u)) return
 
                 if (merge_type == 'merge' .or. merge_type == 'sum_with_weights') then
                    string = trim(merge_frac)//'*'//trim(merge_field)//'('//trim(src_comp)//')'

diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90
@@ -39,7 +39,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc)
     use esmFlds               , only : addmap_from => med_fldList_addmap_from
     use esmFlds               , only : addfld_aoflux => med_fldList_addfld_aoflux
     use esmFlds               , only : addmap_aoflux => med_fldList_addmap_aoflux
-    
+
     use med_internalstate_mod , only : InternalState, mastertask, logunit
 
     ! input/output parameters:
@@ -576,7 +576,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc)
        else
           if ( fldchk(is_local%wrap%FBexp(compocn)        , trim(fldname), rc=rc) .and. &
                fldchk(is_local%wrap%FBImp(compwav,compwav), trim(fldname), rc=rc)) then
-             call addmap_from(compwav, trim(fldname), compocn, mapfcopy, 'unset', 'unset')
+             call addmap_from(compwav, trim(fldname), compocn, mapbilnr_nstod, 'one', 'unset')
              call addmrg_to(compocn, trim(fldname), mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy')
           end if
        end if
@@ -671,6 +671,20 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc)
     end do
     deallocate(flds)
 
+    if (phase == 'advertise') then
+       if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compwav)) then
+          call addfld_from(compwav, 'Sw_elevation_spectrum')
+          call addfld_to(compice, 'Sw_elevation_spectrum')
+       end if
+    else
+       if ( fldchk(is_local%wrap%FBExp(compice)        , 'Sw_elevation_spectrum', rc=rc) .and. &
+            fldchk(is_local%wrap%FBImp(compwav,compwav), 'Sw_elevation_spectrum', rc=rc)) then
+          call addmap_from(compwav, 'Sw_elevation_spectrum', compice, mapbilnr_nstod, 'one', 'unset')
+          call addmrg_to(compice, 'Sw_elevation_spectrum', mrg_from=compwav, &
+               mrg_fld='Sw_elevation_spectrum', mrg_type='copy')
+       end if
+    end if
+
     !=====================================================================
     ! FIELDS TO WAV (compwav)
     !=====================================================================
@@ -695,19 +709,25 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc)
      end do
      deallocate(flds)
 
-     ! to wav: sea ice fraction
-     if (phase == 'advertise') then
-        if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compwav)) then
-           call addfld_from(compice, 'Si_ifrac')
-           call addfld_to(compwav, 'Si_ifrac')
+     ! to wav: sea ice fraction, thickness and floe diameter
+     allocate(flds(3))
+     flds = (/'Si_ifrac   ', 'Si_floediam', 'Si_thick   '/)
+     do n = 1,size(flds)
+        fldname = trim(flds(n))
+        if (phase == 'advertise') then
+           if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compwav)) then
+              call addfld_from(compice, trim(fldname))
+              call addfld_to(compwav, trim(fldname))
         end if
-     else
-        if ( fldchk(is_local%wrap%FBexp(compwav)        , 'Si_ifrac', rc=rc) .and. &
-             fldchk(is_local%wrap%FBImp(compice,compice), 'Si_ifrac', rc=rc)) then
-            call addmap_from(compice, 'Si_ifrac', compwav, mapfcopy , 'unset', 'unset')
-            call addmrg_to(compwav, 'Si_ifrac', mrg_from=compice, mrg_fld='Si_ifrac', mrg_type='copy')
+        else
+           if ( fldchk(is_local%wrap%FBexp(compwav)        , trim(fldname), rc=rc) .and. &
+                fldchk(is_local%wrap%FBImp(compice,compice), trim(fldname), rc=rc)) then
+              call addmap_from(compice, trim(fldname), compwav, mapbilnr_nstod , 'one', 'unset')
+              call addmrg_to(compwav, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy')
+           end if
         end if
-     end if
+      end do
+      deallocate(flds)
 
      ! to wav: zonal sea water velocity from ocn
      ! to wav: meridional sea water velocity from ocn
@@ -724,7 +744,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc)
         else
            if ( fldchk(is_local%wrap%FBexp(compwav)        , trim(fldname), rc=rc) .and. &
                 fldchk(is_local%wrap%FBImp(compocn,compocn), trim(fldname), rc=rc)) then
-              call addmap_from(compocn, trim(fldname), compwav, mapfcopy , 'unset', 'unset')
+              call addmap_from(compocn, trim(fldname), compwav, mapbilnr_nstod , 'one', 'unset')
               call addmrg_to(compwav, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy')
            end if
         end if
@@ -741,7 +761,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc)
        flds = (/'Sa_z      ', 'Sa_topo   ', 'Sa_tbot   ', 'Sa_pbot   ', &
                 'Sa_shum   ', 'Sa_u      ', 'Sa_v      ', 'Faxa_lwdn ', &
                 'Sa_ptem   ', 'Sa_dens   ', 'Faxa_swdn ', 'Sa_pslv   ', &
-                'Faxa_snowc', 'Faxa_snowl', 'Faxa_rainc', 'Faxa_rainl', & 
+                'Faxa_snowc', 'Faxa_snowl', 'Faxa_rainc', 'Faxa_rainl', &
                 'Faxa_swndr', 'Faxa_swndf', 'Faxa_swvdr', 'Faxa_swvdf', &
                 'Faxa_swnet'/)
     else

diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90
@@ -424,10 +424,10 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex,
     call ESMF_LogWrite(trim(string), ESMF_LOGMSG_INFO)
 
     polemethod=ESMF_POLEMETHOD_ALLAVG
-    if (trim(coupling_mode) == 'cesm') then
-      if (n1 == compwav .or. n2 == compwav) then
-        polemethod = ESMF_POLEMETHOD_NONE ! todo: remove this when ESMF tripolar mapping fix is in place.
-      endif
+    if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode(1:4)) == 'nems') then
+       if (n1 == compwav .or. n2 == compwav) then
+         polemethod = ESMF_POLEMETHOD_NONE ! todo: remove this when ESMF tripolar mapping fix is in place.
+       endif
     end if
 
     ! Create route handle

diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90
@@ -130,7 +130,7 @@ module med_phases_aofluxes_mod
      integer            :: lsize                     ! local size
      integer  , pointer :: mask        (:) => null() ! integer ocn domain mask: 0 <=> inactive cell
      real(R8) , pointer :: rmask       (:) => null() ! real    ocn domain mask: 0 <=> inactive cell
-     real(R8) , pointer :: garea       (:) => null() ! atm grid area 
+     real(R8) , pointer :: garea       (:) => null() ! atm grid area
   end type aoflux_in_type
 
   type aoflux_out_type

diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90
@@ -4,7 +4,7 @@ module med_phases_post_atm_mod
   ! Mediator phase for post atm calculations, maps atm->ice, atm->lnd, atm->ocn
   ! and atm->wav
   !-----------------------------------------------------------------------------
-
+ 
   implicit none
   private
 

diff --git a/ufs/ccpp/data/MED_typedefs.meta b/ufs/ccpp/data/MED_typedefs.meta
@@ -772,7 +772,7 @@
 [use_med_flux]
   standard_name = do_mediator_atmosphere_ocean_fluxes
   long_name = flag for using atmosphere-ocean fluxes form mediator (default false)
-  units = flag 
+  units = flag
   dimensions = ()
   type = logical
 [ivegsrc]
@@ -1234,7 +1234,7 @@
   name = MED_typedefs
   type = module
   relative_path = ../../../../../FV3/ccpp/physics/physics
-  dependencies = machine.F,physcons.F90,physparam.f
+  dependencies = machine.F,physcons.F90
 
 [ccpp-arg-table]
   name = MED_typedefs