Draft: Add a shareable generic datamode

datm/atm_comp_nuopc.F90

@@ -32,6 +32,7 @@ module cdeps_datm_comp
   use shr_log_mod      , only : shr_log_setLogUnit, shr_log_error
   use dshr_methods_mod , only : dshr_state_diagnose, chkerr, memcheck
   use dshr_strdata_mod , only : shr_strdata_type, shr_strdata_init_from_config, shr_strdata_advance
+  use dshr_strdata_mod , only : shr_strdata_init_advertise, shr_strdata_init_realize
   use dshr_strdata_mod , only : shr_strdata_get_stream_pointer, shr_strdata_setOrbs
   use dshr_mod         , only : dshr_model_initphase, dshr_init, dshr_restart_write
   use dshr_mod         , only : dshr_state_setscalar, dshr_set_runclock, dshr_log_clock_advance
@@ -83,6 +84,10 @@ module cdeps_datm_comp
   use datm_pres_co2_mod         , only : datm_pres_co2_init_pointers
   use datm_pres_co2_mod         , only : datm_pres_co2_advance
 
+  use dshr_generic_mod          , only : datamode_generic_advertise
+  use dshr_generic_mod          , only : datamode_generic_init_pointers
+  use dshr_generic_mod          , only : datamode_generic_advance
+
   implicit none
   private
 
@@ -366,13 +371,21 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
     select case (trim(datamode))
        case ('CORE2_NYF','CORE2_IAF','CORE_IAF_JRA', &
              'CORE_RYF6162_JRA','CORE_RYF8485_JRA','CORE_RYF9091_JRA','CORE_RYF0304_JRA', &
-             'CLMNCEP','CPLHIST','GEFS','ERA5','SIMPLE')
+             'CLMNCEP','CPLHIST','GEFS','ERA5','SIMPLE','GENERIC')
        if (mainproc) write(logunit,'(3a)') subname,'datm datamode = ',trim(datamode)
     case default
        call shr_log_error(' ERROR illegal datm datamode = '//trim(datamode), rc=rc)
        return
     end select
 
+    ! Initialize stream data type
+    streamfilename = 'datm.streams'//trim(inst_suffix)
+#ifndef DISABLE_FoX
+    streamfilename = trim(streamfilename)//'.xml'
+#endif
+    call shr_strdata_init_advertise(sdat, streamfilename, 'ATM', logunit, rc=rc)
+    if (ChkErr(rc,__LINE__,u_FILE_u)) return
+
     ! Advertise fields that ARE NOT datamode specific
     if (flds_co2) then
        call datm_pres_co2_advertise(fldsExport, datamode)
@@ -411,6 +424,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
        call datm_datamode_simple_advertise(exportState, fldsExport, flds_scalar_name, &
             nlfilename, my_task, vm, rc)
        if (ChkErr(rc,__LINE__,u_FILE_u)) return
+    case ('GENERIC')
+       call datamode_generic_advertise(fldsExport, sdat, rc)
+       if (ChkErr(rc,__LINE__,u_FILE_u)) return
     end select
 
   end subroutine InitializeAdvertise
@@ -454,12 +470,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc)
          model_meshfile, model_maskfile, model_mesh, model_mask, model_frac, restart_read, rc=rc)
     if (ChkErr(rc,__LINE__,u_FILE_u)) return
 
-    ! Initialize stream data type
-    streamfilename = 'datm.streams'//trim(inst_suffix)
-#ifndef DISABLE_FoX
-    streamfilename = trim(streamfilename)//'.xml'
-#endif
-    call shr_strdata_init_from_config(sdat, streamfilename, model_mesh, clock, 'ATM', logunit, rc=rc)
+    call shr_strdata_init_realize(sdat, model_mesh, clock, rc)
     if (ChkErr(rc,__LINE__,u_FILE_u)) return
     call ESMF_TraceRegionExit('datm_strdata_init')
 
@@ -677,6 +688,9 @@ subroutine datm_comp_run(gcomp, importState, exportState, target_ymd, target_tod
        case('SIMPLE')
           call datm_datamode_simple_init_pointers(exportState, sdat, rc)
           if (ChkErr(rc,__LINE__,u_FILE_u)) return
+       case('GENERIC')
+          call datamode_generic_init_pointers(exportState, sdat, rc)
+          if (ChkErr(rc,__LINE__,u_FILE_u)) return
        end select
 
        ! Read restart if needed
@@ -687,7 +701,7 @@ subroutine datm_comp_run(gcomp, importState, exportState, target_ymd, target_tod
           case('CORE2_NYF','CORE2_IAF','CORE_IAF_JRA',&
                'CORE_RYF6162_JRA','CORE_RYF8485_JRA' ,&
                'CORE_RYF9091_JRA','CORE_RYF0304_JRA' ,&
-               'CLMNCEP','CPLHIST','ERA5','GEFS','SIMPLE')
+               'CLMNCEP','CPLHIST','ERA5','GEFS','SIMPLE','GENERIC')
              call dshr_restart_read(restfilm, rpfile, logunit, my_task, mpicom, sdat, rc)
              if (ChkErr(rc,__LINE__,u_FILE_u)) return
           case default
@@ -755,6 +769,9 @@ subroutine datm_comp_run(gcomp, importState, exportState, target_ymd, target_tod
     case('SIMPLE')
        call datm_datamode_simple_advance(target_ymd, target_tod, target_mon, sdat%model_calendar, rc)
        if (ChkErr(rc,__LINE__,u_FILE_u)) return
+    case('GENERIC')
+       call datamode_generic_advance(rc)
+       if (ChkErr(rc,__LINE__,u_FILE_u)) return
     end select
 
     ! Write restarts if needed
@@ -765,7 +782,7 @@ subroutine datm_comp_run(gcomp, importState, exportState, target_ymd, target_tod
        case('CORE2_NYF','CORE2_IAF','CORE_IAF_JRA',&
             'CORE_RYF6162_JRA','CORE_RYF8485_JRA' ,&
             'CORE_RYF9091_JRA','CORE_RYF0304_JRA' ,&
-            'CLMNCEP','CPLHIST','ERA5','GEFS','SIMPLE')
+            'CLMNCEP','CPLHIST','ERA5','GEFS','SIMPLE','GENERIC')
           call dshr_restart_write(rpfile, case_name, 'datm', inst_suffix, &
                target_ymd, target_tod, logunit, my_task, sdat, rc)
           if (ChkErr(rc,__LINE__,u_FILE_u)) return

dshr/CMakeLists.txt

@@ -2,7 +2,8 @@ project(dshr Fortran)
 
 set(SRCFILES  dshr_dfield_mod.F90
               dshr_fldlist_mod.F90
-              dshr_mod.F90)
+              dshr_mod.F90
+              dshr_generic_mod.F90)
 
 foreach(FILE ${SRCFILES})
   if(EXISTS "${CASEROOT}/SourceMods/src.cdeps/${FILE}")

dshr/dshr_generic_mod.F90

@@ -0,0 +1,161 @@
+module dshr_generic_mod
+
+  use ESMF            , only : ESMF_SUCCESS, ESMF_State, &
+                               ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_WARNING
+  use shr_kind_mod    , only : r8=>shr_kind_r8, cl=>shr_kind_cl
+  use dshr_fldlist_mod, only : fldlist_type, dshr_fldlist_add
+  use dshr_strdata_mod, only : shr_strdata_type, shr_strdata_get_stream_pointer
+  use dshr_methods_mod, only : dshr_state_getfldptr, chkerr
+
+  implicit none
+  private
+
+  public :: datamode_generic_advertise
+  public :: datamode_generic_init_pointers
+  public :: datamode_generic_advance
+  public :: datamode_generic_clean
+
+  ! -----------------------------------------------------------------------
+  ! Derived type to cache the pointer pairs dynamically for the Advance loop
+  ! -----------------------------------------------------------------------
+  type :: ptr_map_type
+     real(r8), pointer :: strm_ptr(:)  => null()
+     real(r8), pointer :: state_ptr(:) => null()
+  end type ptr_map_type
+
+  ! Module-level cache array
+  type(ptr_map_type), allocatable :: ptr_cache(:)
+
+  character(len=*) , parameter :: u_FILE_u = &
+       __FILE__
+
+contains
+
+  ! =======================================================================
+  subroutine datamode_generic_advertise(fldsExport, sdat, rc)
+    type(fldList_type),     pointer       :: fldsExport
+    type(shr_strdata_type), intent(in)    :: sdat
+    integer,        intent(out), optional :: rc
+
+    integer :: i, n
+    character(len=CL) :: fieldName
+
+    if (present(rc)) rc = ESMF_SUCCESS
+
+    ! Natively access the array of stream objects inside sdat
+    if (associated(sdat%stream)) then
+       do i = 1, size(sdat%stream)
+          if (sdat%stream(i)%nvars > 0 .and. allocated(sdat%stream(i)%varlist)) then
+
+             ! Extract the 'nameinmodel' string directly from the varlist
+             do n = 1, sdat%stream(i)%nvars
+                fieldName = trim(sdat%stream(i)%varlist(n)%nameinmodel)
+
+                ! Add to the CDEPS list (which handles the NUOPC advertise)
+                call dshr_fldlist_add(fldsExport, trim(fieldName))
+             end do
+
+          endif
+       end do
+    endif
+
+  end subroutine datamode_generic_advertise
+
+  ! =======================================================================
+  subroutine datamode_generic_init_pointers(exportState, sdat, rc)
+    type(ESMF_State),       intent(inout) :: exportState
+    type(shr_strdata_type), intent(in)    :: sdat
+    integer,                intent(out)   :: rc
+
+    integer :: i, n, total_vars, cache_idx
+    character(len=CL) :: fieldName
+    character(len=CL) :: logMsg
+
+    rc = ESMF_SUCCESS
+
+    ! 1. Count the total number of fields to allocate the cache
+    total_vars = 0
+    if (associated(sdat%stream)) then
+       do i = 1, size(sdat%stream)
+          if (allocated(sdat%stream(i)%varlist)) then
+             total_vars = total_vars + sdat%stream(i)%nvars
+          endif
+       end do
+    endif
+
+    ! Allocate the module-level pointer cache
+    if (allocated(ptr_cache)) deallocate(ptr_cache)
+    if (total_vars > 0) allocate(ptr_cache(total_vars))
+
+    ! Populate the cache and log fieldName diagnostics
+    cache_idx = 1
+    if (associated(sdat%stream)) then
+       do i = 1, size(sdat%stream)
+          if (allocated(sdat%stream(i)%varlist)) then
+             do n = 1, sdat%stream(i)%nvars
+                fieldName = trim(sdat%stream(i)%varlist(n)%nameinmodel)
+
+                ! Look up stream array pointer
+                call shr_strdata_get_stream_pointer(sdat, fieldName, &
+                                                    ptr_cache(cache_idx)%strm_ptr, rc=rc)
+                if (ChkErr(rc,__LINE__,u_FILE_u)) return
+
+                ! Look up NUOPC export array pointer (allow null if CMEPS didn't connect it)
+                call dshr_state_getfldptr(exportState, fieldName, &
+                                          fldptr1=ptr_cache(cache_idx)%state_ptr, &
+                                          allowNullReturn=.true., rc=rc)
+                if (ChkErr(rc,__LINE__,u_FILE_u)) return
+
+                ! Diagnostic Logging
+                if (.not. associated(ptr_cache(cache_idx)%state_ptr)) then
+                   write(logMsg, '(A,A,A)') "GENERIC Datamode INFO: field '", trim(fieldName), &
+                                            "' ignored. Not requested by CMEPS mediator."
+                   call ESMF_LogWrite(trim(logMsg), ESMF_LOGMSG_INFO)
+                endif
+
+                if (.not. associated(ptr_cache(cache_idx)%strm_ptr)) then
+                   write(logMsg, '(A,A,A)') "GENERIC Datamode WARNING: field '", trim(fieldName), &
+                                            "' missing from internal stream buffer."
+                   call ESMF_LogWrite(trim(logMsg), ESMF_LOGMSG_WARNING)
+                endif
+
+                cache_idx = cache_idx + 1
+             end do
+          endif
+       end do
+    endif
+
+  end subroutine datamode_generic_init_pointers
+
+
+  ! =======================================================================
+  subroutine datamode_generic_advance(rc)
+    integer, intent(out), optional :: rc
+
+    integer :: i
+
+    if (present(rc)) rc = ESMF_SUCCESS
+
+    if (allocated(ptr_cache)) then
+       do i = 1, size(ptr_cache)
+          if (associated(ptr_cache(i)%strm_ptr) .and. associated(ptr_cache(i)%state_ptr)) then
+             ptr_cache(i)%state_ptr(:) = ptr_cache(i)%strm_ptr(:)
+          endif
+       end do
+    endif
+
+  end subroutine datamode_generic_advance
+
+  ! =======================================================================
+  subroutine datamode_generic_clean(rc)
+    integer, intent(out), optional :: rc
+
+    if (present(rc)) rc = ESMF_SUCCESS
+
+    if (allocated(ptr_cache)) then
+       deallocate(ptr_cache)
+    endif
+
+  end subroutine datamode_generic_clean
+
+end module dshr_generic_mod

streams/dshr_strdata_mod.F90

@@ -63,6 +63,8 @@ module dshr_strdata_mod
 
   ! Public routines
   public  :: shr_strdata_init_from_config
+  public  :: shr_strdata_init_advertise
+  public  :: shr_strdata_init_realize
   public  :: shr_strdata_init_from_inline
   public  :: shr_strdata_setOrbs
   public  :: shr_strdata_advance
@@ -188,13 +190,10 @@ type(ESMF_FieldBundle) function shr_strdata_get_stream_fieldbundle(sdat, ns, nam
   end function shr_strdata_get_stream_fieldbundle
 
   !===============================================================================
-  subroutine shr_strdata_init_from_config(sdat, streamfilename, model_mesh, clock, compname, logunit, rc)
-
+  subroutine shr_strdata_init_advertise(sdat, streamfilename, compname, logunit, rc)
     ! input/output variables
     type(shr_strdata_type)     , intent(inout) :: sdat
     character(len=*)           , intent(in)    :: streamfilename
-    type(ESMF_Mesh)            , intent(in)    :: model_mesh
-    type(ESMF_Clock)           , intent(in)    :: clock
     character(len=*)           , intent(in)    :: compname
     integer                    , intent(in)    :: logunit
     integer                    , intent(out)   :: rc
@@ -204,8 +203,8 @@ subroutine shr_strdata_init_from_config(sdat, streamfilename, model_mesh, clock,
     type(ESMF_VM) :: vm
     integer       :: stream_count
     integer       :: istat
-    character(len=*), parameter  :: subname='(shr_strdata_init_from_config)'
-    ! ----------------------------------------------
+    character(len=*), parameter  :: subname='(shr_strdata_init_advertise)'
+
     rc = ESMF_SUCCESS
 
 #ifdef CESMCOUPLED
@@ -244,6 +243,16 @@ subroutine shr_strdata_init_from_config(sdat, streamfilename, model_mesh, clock,
             ': allocation error for sdat%pstrm with stream_count '//toString(stream_count), rc=rc)
        return
     end if
+  end subroutine shr_strdata_init_advertise
+
+  !===============================================================================
+  subroutine shr_strdata_init_realize(sdat, model_mesh, clock, rc)
+
+    ! input/output variables
+    type(shr_strdata_type)     , intent(inout) :: sdat
+    type(ESMF_Mesh)            , intent(in)    :: model_mesh
+    type(ESMF_Clock)           , intent(in)    :: clock
+    integer                    , intent(out)   :: rc
 
     ! Initialize sdat model domain
     sdat%model_mesh = model_mesh
@@ -254,6 +263,30 @@ subroutine shr_strdata_init_from_config(sdat, streamfilename, model_mesh, clock,
     call shr_strdata_init(sdat, clock, rc=rc)
     if (ChkErr(rc,__LINE__,u_FILE_u)) return
 
+  end subroutine shr_strdata_init_realize
+
+  !===============================================================================
+  subroutine shr_strdata_init_from_config(sdat, streamfilename, model_mesh, clock, compname, logunit, rc)
+
+    ! input/output variables
+    type(shr_strdata_type)     , intent(inout) :: sdat
+    character(len=*)           , intent(in)    :: streamfilename
+    type(ESMF_Mesh)            , intent(in)    :: model_mesh
+    type(ESMF_Clock)           , intent(in)    :: clock
+    character(len=*)           , intent(in)    :: compname
+    integer                    , intent(in)    :: logunit
+    integer                    , intent(out)   :: rc
+
+    ! local variables
+    character(len=*), parameter  :: subname='(shr_strdata_init_from_config)'
+    ! ----------------------------------------------
+
+    call shr_strdata_init_advertise(sdat, streamfilename, compname, logunit, rc)
+    if (ChkErr(rc,__LINE__,u_FILE_u)) return
+
+    call shr_strdata_init_realize(sdat, model_mesh, clock, rc)
+    if (ChkErr(rc,__LINE__,u_FILE_u)) return
+
   end subroutine shr_strdata_init_from_config
 
   !===============================================================================