CMEPS PR for CDEPS Inline implementation

cesm/driver/ensemble_driver.F90

@@ -145,7 +145,7 @@ subroutine SetModelServices(ensemble_driver, rc)
     integer                :: pio_asyncio_stride
     integer                :: pio_asyncio_rootpe
     integer                :: Global_Comm
-    character(len=CL)          :: start_type     ! Type of startup
+    character(len=CL)      :: start_type     ! Type of startup
     character(len=7)       :: drvrinst
     character(len=5)       :: inst_suffix
     character(len=CX)      :: msgstr
@@ -377,10 +377,8 @@ subroutine SetModelServices(ensemble_driver, rc)
        endif
        call shr_log_setLogUnit (logunit)
        ! Create a clock for each driver instance
-
        call esm_time_clockInit(ensemble_driver, driver, logunit, localpet==petList(1), rc)
        if (chkerr(rc,__LINE__,u_FILE_u)) return
-
     enddo
     inst = localPet/(ntasks_per_member+pio_asyncio_ntasks) + 1
 

cesm/driver/esm.F90

@@ -1517,6 +1517,7 @@ subroutine esm_finalize(driver, rc)
 
     call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO)
     rc = ESMF_SUCCESS
+
     call shr_log_setLogunit(logunit)
     call ESMF_GridCompGet(driver, vm=vm, rc=rc)
     if (chkerr(rc,__LINE__,u_FILE_u)) return

cesm/driver/esm_time_mod.F90

@@ -282,7 +282,6 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas
     call ESMF_TimeSet( RefTime, yy=yr, mm=mon, dd=day, s=ref_tod, rc=rc)
     if (ChkErr(rc,__LINE__,u_FILE_u)) return
 
-
     call ESMF_TimeIntervalSet( TimeStep, s=dtime_drv, rc=rc )
     if (ChkErr(rc,__LINE__,u_FILE_u)) return
 

mediator/esmFldsExchange_ufs_mod.F90

@@ -151,14 +151,6 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc)
        call addfld_ocnalb('So_anidf')
     end if
 
-    ! Advertise the ocean albedos. These are not sent to the ATM in UFS.
-    if (phase == 'advertise') then
-       call addfld_ocnalb('So_avsdr')
-       call addfld_ocnalb('So_avsdf')
-       call addfld_ocnalb('So_anidr')
-       call addfld_ocnalb('So_anidf')
-    end if
-
     !=====================================================================
     ! FIELDS TO ATMOSPHERE (compatm)
     !=====================================================================
@@ -242,18 +234,46 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc)
        end if
     end if
 
-    ! to atm: unmerged surface temperatures from lnd
-    if (phase == 'advertise') then
-       if (is_local%wrap%comp_present(complnd) .and. is_local%wrap%comp_present(compatm)) then
-          call addfld_from(complnd , 'Sl_t')
-          call addfld_to(compatm   , 'Sl_t')
+    ! to atm: unmerged flux components from lnd
+    if (is_local%wrap%comp_present(complnd) .and. is_local%wrap%comp_present(compatm)) then
+       allocate(flds(6))
+       flds = (/ 'lat ', 'sen ', 'evap', 'gflx', 'roff', 'soff' /)
+       if (phase == 'advertise') then
+          do n = 1,size(flds)
+             call addfld_from(complnd, 'Fall_'//trim(flds(n)))
+             call addfld_to(compatm, 'Fall_'//trim(flds(n)))
+          end do
+       else
+          do n = 1,size(flds)
+             if ( fldchk(is_local%wrap%FBexp(compatm)        , 'Fall_'//trim(flds(n)), rc=rc) .and. &
+                  fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_'//trim(flds(n)), rc=rc)) then
+                call addmap_from(complnd, 'Fall_'//trim(flds(n)), compatm, maptype, 'lfrac', 'unset')
+                call addmrg_to(compatm, 'Fall_'//trim(flds(n)), mrg_from=complnd, mrg_fld='Fall_'//trim(flds(n)), mrg_type='copy')
+             end if
+          end do
        end if
-    else
-       if ( fldchk(is_local%wrap%FBexp(compatm)        , 'Sl_t', rc=rc) .and. &
-            fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_t', rc=rc)) then
-          call addmap_from(complnd, 'Sl_t', compatm, maptype, 'lfrin', 'unset')
-          call addmrg_to(compatm, 'Sl_t', mrg_from=complnd, mrg_fld='Sl_t', mrg_type='copy')
+       deallocate(flds)
+    end if
+
+    ! to atm: unmerged state variables from lnd
+    if (is_local%wrap%comp_present(complnd) .and. is_local%wrap%comp_present(compatm)) then
+       allocate(flds(7))
+       flds = (/ 'sfrac', 'tref ', 'qref ', 'q    ', 'cmm  ', 'chh  ', 'zvfun' /)
+       if (phase == 'advertise') then
+          do n = 1,size(flds)
+             call addfld_from(complnd, 'Sl_'//trim(flds(n)))
+             call addfld_to(compatm, 'Sl_'//trim(flds(n)))
+          end do
+       else
+          do n = 1,size(flds)
+             if ( fldchk(is_local%wrap%FBexp(compatm)        , 'Sl_'//trim(flds(n)), rc=rc) .and. &
+                  fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_'//trim(flds(n)), rc=rc)) then
+                call addmap_from(complnd, 'Sl_'//trim(flds(n)), compatm, maptype, 'lfrac', 'unset')
+                call addmrg_to(compatm, 'Sl_'//trim(flds(n)), mrg_from=complnd, mrg_fld='Sl_'//trim(flds(n)), mrg_type='copy')
+             end if
+          end do
        end if
+       deallocate(flds)
     end if
 
     ! to atm: unmerged from mediator, merge will be done under FV3/CCPP composite step
@@ -724,18 +744,16 @@ subroutine esmFldsExchange_ufs(gcomp, phase, rc)
     if ( trim(coupling_mode) == 'ufs.nfrac.aoflux') then
        allocate(flds(21))
        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_swndr', 'Faxa_swndf', 'Faxa_swvdr', 'Faxa_swvdf', &
-                'Faxa_swnet'/)
+                'Sa_shum   ', 'Sa_u      ', 'Sa_v      ', 'Sa_pslv   ', &
+                'Faxa_lwdn ', 'Faxa_swdn ', 'Faxa_snowc', 'Faxa_snowl', &
+                'Faxa_rainc', 'Faxa_rainl', 'Faxa_rain ', 'Faxa_swnet'/)
     else
        allocate(flds(18))
        flds = (/'Sa_z      ', 'Sa_ta     ', 'Sa_pslv   ', 'Sa_qa     ', &
-                'Sa_ua     ', 'Sa_va     ', 'Faxa_swdn ', 'Faxa_lwdn ', &
-                'Faxa_swnet', 'Faxa_rain ', 'Sa_prsl   ', 'vfrac     ', &
+                'Sa_u      ', 'Sa_v      ', 'Faxa_swdn ', 'Faxa_lwdn ', &
+                'Faxa_swnet', 'Faxa_rain ', 'Sa_prsl   ', 'Sa_vfrac  ', &
                 'Faxa_snow ', 'Faxa_rainc', 'Sa_tskn   ', 'Sa_exner  ', &
-                'Sa_ustar  ', 'zorl      ' /)
+                'Sa_ustar  ', 'Sa_zorl   ' /)
     end if
     do n = 1,size(flds)
        fldname = trim(flds(n))

mediator/med.F90

@@ -123,6 +123,9 @@ subroutine SetServices(gcomp, rc)
     use med_diag_mod            , only: med_phases_diag_ice_ice2med, med_phases_diag_ice_med2ice
     use med_fraction_mod        , only: med_fraction_init, med_fraction_set
     use med_phases_profile_mod  , only: med_phases_profile
+#ifdef CDEPS_INLINE
+    use med_phases_cdeps_mod    , only: med_phases_cdeps_run
+#endif
 
     ! input/output variables
     type(ESMF_GridComp)  :: gcomp
@@ -505,6 +508,19 @@ subroutine SetServices(gcomp, rc)
          specPhaselabel="med_phases_diag_print", specRoutine=NUOPC_NoOp, rc=rc)
     if (ChkErr(rc,__LINE__,u_FILE_u)) return
 
+#ifdef CDEPS_INLINE
+    !------------------
+    ! phase routine for cdeps inline capabilty 
+    !------------------
+
+    call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, &
+         phaseLabelList=(/"med_phases_cdeps_run"/), 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_cdeps_run", specRoutine=med_phases_cdeps_run, rc=rc)
+    if (ChkErr(rc,__LINE__,u_FILE_u)) return
+#endif
+
     !------------------
     ! attach specializing method(s)
     ! -> NUOPC specializes by default --->>> first need to remove the default
@@ -934,6 +950,22 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc)
        endif
     endif
 
+    ! Should target component use all data for first time step?
+    do ncomp = 1,ncomps
+       if (ncomp /= compmed) then
+          call NUOPC_CompAttributeGet(gcomp, name=trim(compname(ncomp))//"_use_data_first_import", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc)
+          if (ChkErr(rc,__LINE__,u_FILE_u)) return
+          if (isPresent .and. isSet) then
+             read(cvalue, *) is_local%wrap%med_data_force_first(ncomp)
+          else
+             is_local%wrap%med_data_force_first(ncomp) = .false.
+          endif
+          if (maintask) then
+             write(logunit,*) trim(compname(ncomp))//'_use_data_first_import is ', is_local%wrap%med_data_force_first(ncomp)
+          endif    
+       end if
+    end do
+
     if (profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname))
     call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO)
 
@@ -1023,7 +1055,6 @@ subroutine ModifyDecompofMesh(gcomp, importState, exportState, clock, rc)
     type(InternalState) :: is_local
     integer :: n1
     character(len=*), parameter :: subname = '('//__FILE__//':ModifyDecompofMesh)'
-
     !-----------------------------------------------------------
 
     call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO)
@@ -1352,7 +1383,6 @@ subroutine RealizeFieldsWithTransferAccept(gcomp, importState, exportState, cloc
     type(InternalState) :: is_local
     integer             :: n1
     character(len=*), parameter :: subname = '('//__FILE__//':RealizeFieldsWithTransferAccept)'
-
     !-----------------------------------------------------------
 
     call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO)
@@ -1805,7 +1835,7 @@ subroutine DataInitialize(gcomp, rc)
       else if (trim(coupling_mode(1:3)) == 'ufs') then
          call esmFldsExchange_ufs(gcomp, phase='initialize', rc=rc)
          if (ChkErr(rc,__LINE__,u_FILE_u)) return
-      else if (trim(coupling_mode) == 'hafs') then
+      else if (trim(coupling_mode(1:4)) == 'hafs') then
          call esmFldsExchange_hafs(gcomp, phase='initialize', rc=rc)
          if (ChkErr(rc,__LINE__,u_FILE_u)) return
       end if
@@ -2222,7 +2252,6 @@ subroutine SetRunClock(gcomp, rc)
     integer                 :: stop_n, stop_ymd
     logical, save           :: stopalarmcreated=.false.
     character(len=*), parameter :: subname = '('//__FILE__//':SetRunClock)'
-
     !-----------------------------------------------------------
 
     rc = ESMF_SUCCESS

mediator/med_internalstate_mod.F90

@@ -19,7 +19,7 @@ module med_internalstate_mod
 
   integer, public :: logunit            ! logunit for mediator log output
   integer, public :: diagunit           ! diagunit for budget output (med main only)
-  logical, public :: maintask=.false. ! is this the maintask
+  logical, public :: maintask = .false. ! is this the maintask
   integer, public :: med_id             ! needed currently in med_io_mod and set in esm.F90
 
   ! Components
@@ -47,7 +47,7 @@ module med_internalstate_mod
   character(len=CS), public :: glc_name = ''
 
   ! Coupling mode
-  character(len=CS), public :: coupling_mode ! valid values are [cesm,ufs.nfrac,ufs.frac,ufs.nfrac.aoflux,ufs.frac.aoflux,hafs]
+  character(len=CS), public :: coupling_mode ! valid values are [cesm,ufs.nfrac,ufs.frac,ufs.nfrac.aoflux,ufs.frac.aoflux,hafs,hafs.mom6]
 
   ! Atmosphere-ocean flux algorithm
   character(len=CS), public :: aoflux_code   ! valid values are [cesm,ccpp]
@@ -119,10 +119,12 @@ module med_internalstate_mod
   type InternalStateStruct
 
     ! Present/allowed coupling/active coupling logical flags
-    logical, pointer :: comp_present(:)            ! comp present flag
-    logical, pointer :: med_coupling_active(:,:)   ! computes the active coupling
-    integer          :: num_icesheets              ! obtained from attribute
-    logical          :: ocn2glc_coupling = .false. ! obtained from attribute
+    logical, pointer :: comp_present(:)               ! comp present flag
+    logical, pointer :: med_coupling_active(:,:)      ! computes the active coupling
+    logical, pointer :: med_data_active(:,:)          ! uses stream data to provide background fill 
+    logical, pointer :: med_data_force_first(:)       ! force to use stream data for first coupling timestep
+    integer          :: num_icesheets                 ! obtained from attribute
+    logical          :: ocn2glc_coupling = .false.    ! obtained from attribute
     logical          :: lnd2glc_coupling = .false.
     logical          :: accum_lnd2glc = .false.
 
@@ -147,10 +149,10 @@ module med_internalstate_mod
     ! FBImp(n,n) = NState_Imp(n), copied in connector post phase
     ! FBImp(n,k) is the FBImp(n,n) interpolated to grid k
     ! Import/export States and field bundles (the field bundles have the scalar fields removed)
-    type(ESMF_State)       , pointer :: NStateImp(:) ! Import data from various component, on their grid
-    type(ESMF_State)       , pointer :: NStateExp(:) ! Export data to various component, on their grid
-    type(ESMF_FieldBundle) , pointer :: FBImp(:,:)   ! Import data from various components interpolated to various grids
-    type(ESMF_FieldBundle) , pointer :: FBExp(:)     ! Export data for various components, on their grid
+    type(ESMF_State)       , pointer :: NStateImp(:)   ! Import data from various component, on their grid
+    type(ESMF_State)       , pointer :: NStateExp(:)   ! Export data to various component, on their grid
+    type(ESMF_FieldBundle) , pointer :: FBImp(:,:)     ! Import data from various components interpolated to various grids
+    type(ESMF_FieldBundle) , pointer :: FBExp(:)       ! Export data for various components, on their grid
 
     ! Mediator field bundles for ocean albedo
     type(ESMF_FieldBundle) :: FBMed_ocnalb_o            ! Ocn albedo on ocn grid
@@ -173,6 +175,9 @@ module med_internalstate_mod
     ! Fractions
     type(ESMF_FieldBundle), pointer :: FBfrac(:)     ! Fraction data for various components, on their grid
 
+    ! Data
+    type(ESMF_FieldBundle) , pointer :: FBData(:)    ! Background data for various components, on their grid, provided by CDEPS inline
+
     ! Accumulators for export field bundles
     type(ESMF_FieldBundle) :: FBExpAccumOcn      ! Accumulator for Ocn export on Ocn grid
     integer                :: ExpAccumOcnCnt = 0 ! Accumulator counter for FBExpAccumOcn
@@ -303,6 +308,8 @@ subroutine med_internalstate_init(gcomp, rc)
 
     ! Allocate memory now that ncomps is determined
     allocate(is_local%wrap%med_coupling_active(ncomps,ncomps))
+    allocate(is_local%wrap%med_data_active(ncomps,ncomps))
+    allocate(is_local%wrap%med_data_force_first(ncomps))
     allocate(is_local%wrap%nx(ncomps))
     allocate(is_local%wrap%ny(ncomps))
     allocate(is_local%wrap%NStateImp(ncomps))
@@ -316,6 +323,7 @@ subroutine med_internalstate_init(gcomp, rc)
     allocate(is_local%wrap%packed_data(ncomps,ncomps,nmappers))
     allocate(is_local%wrap%FBfrac(ncomps))
     allocate(is_local%wrap%FBArea(ncomps))
+    allocate(is_local%wrap%FBData(ncomps))
     allocate(is_local%wrap%mesh_info(ncomps))
 
     ! Determine component names
@@ -364,6 +372,15 @@ subroutine med_internalstate_init(gcomp, rc)
     write(msgString,*) trim(subname)//': Mediator dststatus_print is ',dststatus_print
     call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO)
 
+    ! Initialize flag for background fill using data
+    is_local%wrap%med_data_active(:,:) = .false.
+    is_local%wrap%med_data_active(compocn,compatm) = .true.
+    is_local%wrap%med_data_active(compatm,compocn) = .true.
+    is_local%wrap%med_data_active(compatm,compwav) = .true.
+
+    ! Initialize flag to force using data in first coupling time step
+    is_local%wrap%med_data_force_first(:) = .false.
+
   end subroutine med_internalstate_init
 
   !=====================================================================