Enable CCPP host model under CMEPS and updates for UFS exchange grid capability

mediator/esmFldsExchange_nems_mod.F90

@@ -37,6 +37,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc)
     use esmFlds               , only : addmap => med_fldList_AddMap
     use esmFlds               , only : addmrg => med_fldList_AddMrg
     use esmflds               , only : fldListTo, fldListFr, fldListMed_aoflux, fldListMed_ocnalb
+    use med_internalstate_mod , only : InternalState, mastertask, logunit
 
     ! input/output parameters:
     type(ESMF_GridComp)              :: gcomp
@@ -132,6 +133,39 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc)
        deallocate(flds)
     end if
 
+    if (trim(coupling_mode) == 'nems_frac_aoflux' .or. trim(coupling_mode) == 'nems_frac_aoflux_sbs') then
+       allocate(flds(12))
+       flds = (/'Sa_u     ', 'Sa_v     ', 'Sa_z     ', 'Sa_tbot  ', 'Sa_pbot  ', &
+                'Sa_pslv  ', 'Sa_shum  ', 'Sa_ptem  ', 'Sa_dens  ', 'Sa_u10m  ', &
+                'Sa_v10m  ', 'Faxa_lwdn'/)
+       do n = 1,size(flds)
+          fldname = trim(flds(n))
+          if (phase == 'advertise') then
+             if (is_local%wrap%comp_present(compatm) )then
+                call addfld(fldListFr(compatm)%flds, trim(fldname))
+             end if
+          else
+            if ( fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then
+               call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, maptype, 'one', 'unset')
+            end if
+          end if
+       end do
+       deallocate(flds)
+
+       ! fields returned by the atm/ocn flux computation which are otherwise unadvertised
+       allocate(flds(13))
+       flds = (/'So_tref  ', 'So_qref  ','So_u10   ', 'So_ustar ','So_ssq   ', &
+                'So_re    ', 'So_duu10n','Faox_lwup', 'Faox_sen ','Faox_lat ', &
+                'Faox_evap', 'Faox_taux','Faox_tauy'/)
+       do n = 1,size(flds)
+          fldname = trim(flds(n))
+          if (phase == 'advertise') then
+             call addfld(fldListMed_aoflux%flds, trim(fldname))
+          end if
+       end do
+       deallocate(flds)
+    end if
+
     ! TODO: unused, but required to maintain B4B repro for mediator restarts; should be removed
     if (phase == 'advertise') then
        call addfld(fldListFr(compice)%flds, 'mean_sw_pen_to_ocn')
@@ -215,6 +249,35 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc)
        end if
     end if
 
+    ! to atm: unmerged from mediator, merge will be done under FV3/CCPP composite step
+    ! - zonal surface stress, meridional surface stress
+    ! - surface latent heat flux,
+    ! - surface sensible heat flux
+    ! - surface upward longwave heat flux
+    ! - evaporation water flux from water, not in the list do we need to send it to atm?
+    if (trim(coupling_mode) == 'nems_frac_aoflux') then
+       if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compatm)) then
+          allocate(flds(5))
+          flds = (/ 'lat ', 'sen ', 'lwup', 'taux', 'tauy' /)
+          if (phase == 'advertise') then
+             do n = 1,size(flds)
+                call addfld(fldListMed_aoflux%flds , 'Faox_'//trim(flds(n)))
+                call addfld(fldListTo(compatm)%flds, 'Faox_'//trim(flds(n)))
+             end do
+          else
+             do n = 1,size(flds)
+                if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_'//trim(flds(n)), rc=rc)) then
+                   if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then
+                      call addmap(fldListMed_aoflux%flds, 'Faox_'//trim(flds(n)), compatm, maptype, 'ofrac', 'unset')
+                   end if
+                   call addmrg(fldListTo(compatm)%flds, 'Faox_'//trim(flds(n)), mrg_from=compmed, mrg_fld='Faox_'//trim(flds(n)), mrg_type='copy')
+                end if
+             end do
+          end if
+          deallocate(flds)
+       end if
+    end if
+
     ! to atm: surface roughness length from wav
     if (phase == 'advertise') then
        if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compatm)) then
@@ -310,7 +373,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc)
     end do
     deallocate(flds)
 
-    if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then
+    if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac' .or. &
+        trim(coupling_mode) == 'nems_frac_aoflux_sbs') then
        ! to ocn: merge surface stress (custom merge calculation in med_phases_prep_ocn)
        allocate(oflds(2))
        allocate(aflds(2))
@@ -379,7 +443,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc)
              call addmap(fldListFr(compatm)%flds, 'Faxa_lat', compocn, mapconsf_aofrac, 'aofrac', 'unset')
           end if
        end if
-    else
+    else if (trim(coupling_mode) == 'nems_orig_data' .or. trim(coupling_mode) == 'nems_frac_aoflux') then
        ! nems_orig_data
        ! to ocn: surface stress from mediator and ice stress via auto merge
        allocate(flds(2))

mediator/med.F90

@@ -43,7 +43,7 @@ module MED
   use med_internalstate_mod    , only : med_internalstate_defaultmasks, logunit, mastertask
   use med_internalstate_mod    , only : ncomps, compname
   use med_internalstate_mod    , only : compmed, compatm, compocn, compice, complnd, comprof, compwav, compglc
-  use med_internalstate_mod    , only : coupling_mode
+  use med_internalstate_mod    , only : coupling_mode, aoflux_code, aoflux_ccpp_suite
   use esmFlds                  , only : fldListMed_ocnalb
   use esmFlds                  , only : med_fldList_GetNumFlds, med_fldList_GetFldNames, med_fldList_GetFldInfo
   use esmFlds                  , only : med_fldList_Document_Mapping, med_fldList_Document_Merging
@@ -762,6 +762,36 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc)
     end if
     is_local%wrap%aoflux_grid = trim(cvalue)
 
+    ! Determine aoflux scheme that will be used to compute atmosphere-ocean fluxes [cesm|ccpp]
+    ! TODO: If ccpp is not available it will be always run in cesm mode independent from aoflux_code option
+    call NUOPC_CompAttributeGet(gcomp, name='aoflux_code', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
+    if (chkerr(rc,__LINE__,u_FILE_u)) return
+    if (.not. isPresent .and. .not. isSet) then
+       cvalue = 'cesm'
+    end if
+    aoflux_code = trim(cvalue)
+    if (mastertask) then
+       write(logunit,*) '========================================================'
+       write(logunit,'(a)')trim(subname)//' Mediator aoflux scheme is '//trim(aoflux_code)
+       write(logunit,*) '========================================================'
+    end if
+
+    ! Determine CCPP suite if aoflux scheme set to 'ccpp'
+    if (trim(aoflux_code) == 'ccpp') then
+       call NUOPC_CompAttributeGet(gcomp, name='aoflux_ccpp_suite', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
+       if (chkerr(rc,__LINE__,u_FILE_u)) return
+       if (.not. isPresent .and. .not. isSet) then
+          call ESMF_LogWrite("aoflux_ccpp_suite need to be provided when aoflux_code is set to 'ccpp'", ESMF_LOGMSG_INFO)
+          call ESMF_Finalize(endflag=ESMF_END_ABORT)
+       end if
+       aoflux_ccpp_suite = trim(cvalue)
+       if (mastertask) then
+          write(logunit,*) '========================================================'
+          write(logunit,'(a)')trim(subname)//' Mediator aoflux CCPP suite is '//trim(aoflux_ccpp_suite)
+          write(logunit,*) '========================================================'
+       end if
+    end if
+
     !------------------
     ! Initialize mediator flds
     !------------------

mediator/med_fraction_mod.F90

@@ -367,7 +367,10 @@ subroutine med_fraction_init(gcomp, rc)
        if (chkerr(rc,__LINE__,u_FILE_u)) return
 
       ! Set 'aofrac' in FBfrac(compatm)
-       if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then
+       if (trim(coupling_mode) == 'nems_orig' .or. &
+           trim(coupling_mode) == 'nems_frac' .or. &
+           trim(coupling_mode) == 'nems_frac_aoflux' .or. &
+           trim(coupling_mode) == 'nems_frac_aoflux_sbs') then
           call fldbun_getdata1d(is_local%wrap%FBImp(compatm,compatm), 'Sa_ofrac', Sa_ofrac, rc)
           if (ChkErr(rc,__LINE__,u_FILE_u)) return
           call fldbun_getdata1d(is_local%wrap%FBFrac(compatm), 'aofrac', aofrac, rc)
@@ -789,7 +792,10 @@ subroutine med_fraction_set(gcomp, rc)
              if (ChkErr(rc,__LINE__,u_FILE_u)) return
           end if
           ! Set 'aofrac' from FBImp(compatm) to FBfrac(compatm)
-          if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac') then
+          if (trim(coupling_mode) == 'nems_orig' .or. &
+              trim(coupling_mode) == 'nems_frac' .or. &
+              trim(coupling_mode) == 'nems_frac_aoflux' .or. &
+              trim(coupling_mode) == 'nems_frac_aoflux_sbs') then
              call fldbun_getdata1d(is_local%wrap%FBImp(compatm,compatm), 'Sa_ofrac', Sa_ofrac, rc)
              if (ChkErr(rc,__LINE__,u_FILE_u)) return
              call fldbun_getdata1d(is_local%wrap%FBFrac(compatm), 'aofrac', aofrac, rc)

mediator/med_internalstate_mod.F90

@@ -5,7 +5,7 @@ module med_internalstate_mod
   !-----------------------------------------------------------------------------
 
   use ESMF         , only : ESMF_RouteHandle, ESMF_FieldBundle, ESMF_State, ESMF_Field, ESMF_VM
-  use ESMF         , only : ESMF_GridComp, ESMF_MAXSTR, ESMF_LOGMSG_INFO, ESMF_LOGWRITE
+  use ESMF         , only : ESMF_GridComp, ESMF_Mesh, ESMF_MAXSTR, ESMF_LOGMSG_INFO, ESMF_LOGWRITE
   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
 
@@ -47,7 +47,13 @@ module med_internalstate_mod
   character(len=CS), public :: glc_name = ''
 
   ! Coupling mode
-  character(len=CS), public :: coupling_mode ! valid values are [cesm,nems_orig,nems_frac,nems_orig_data,hafs]
+  character(len=CS), public :: coupling_mode ! valid values are [cesm,nems_orig,nems_frac,nems_orig_data,hafs,nems_frac_aoflux,nems_frac_aoflux_sbs]
+
+  ! Atmosphere-ocean flux algorithm
+  character(len=CS), public :: aoflux_code   ! valid values are [cesm,ccpp]
+
+  ! Atmosphere-ocean CCPP suite name
+  character(len=CL), public :: aoflux_ccpp_suite
 
   ! Default src and destination masks for mapping
   integer, public, allocatable :: defaultMasks(:,:)
@@ -153,6 +159,7 @@ module med_internalstate_mod
 
     ! Mediator field bundles and other info for atm/ocn flux computation
     character(len=CS)      :: aoflux_grid                        ! 'ogrid', 'agrid' or 'xgrid'
+    type(ESMF_Mesh)        :: aoflux_mesh                        ! Mesh used for atm/ocn flux computation
     type(ESMF_FieldBundle) :: FBMed_aoflux_a                     ! Ocn/Atm flux output fields on atm grid
     type(ESMF_FieldBundle) :: FBMed_aoflux_o                     ! Ocn/Atm flux output fields on ocn grid
     type(packed_data_type), pointer :: packed_data_aoflux_o2a(:) ! packed data for mapping ocn->atm

mediator/med_io_mod.F90

@@ -1111,12 +1111,14 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, &
                       call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue)
                    end if
                 end do
-             else if (rank == 1) then
+             else if (rank == 1 .or. rank == 0) then
                 name1 = trim(lpre)//'_'//trim(itemc)
                 rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid)
                 call pio_setframe(io_file(lfile_ind),varid,frame)
+                ! fix for writing data on exchange grid, which has no data in some PETs
+                if (rank == 0) nullify(fldptr1)
                 call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr1, rcode, fillval=lfillvalue)
-             end if  ! end if rank is 2 or 1
+             end if  ! end if rank is 2 or 1 or 0
 
           end if ! end if not "hgt"
        end do  ! end loop over fields in FB