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
 
@@ -261,7 +266,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
 
     ! Obtain flds_scalar values, mpi values, multi-instance values and
     ! set logunit and set shr logging to my log file
-    call dshr_init(gcomp, 'ATM', mpicom, my_task, inst_index, inst_suffix, &
+    call dshr_init(gcomp, sdat, 'ATM', mpicom, my_task, inst_index, inst_suffix, &
          flds_scalar_name, flds_scalar_num, flds_scalar_index_nx, flds_scalar_index_ny, &
          logunit, rc=rc)
     if (ChkErr(rc,__LINE__,u_FILE_u)) return
@@ -366,13 +371,21 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
     select case (trim(datamode))
        case ('CORE2_NYF','CORE2_IAF','CORE_IAF_JRA', 'JRA55do', &
              '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(exportState, fldsExport, sdat, flds_scalar_name, rc)
+       if (ChkErr(rc,__LINE__,u_FILE_u)) return
     end select
 
   end subroutine InitializeAdvertise
@@ -450,16 +466,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc)
 
     ! Initialize mesh, restart flag, compid, and logunit
     call ESMF_TraceRegionEnter('datm_strdata_init')
-    call dshr_mesh_init(gcomp, sdat, nullstr, logunit, 'ATM', nx_global, ny_global, &
+    call dshr_mesh_init(gcomp, nullstr, logunit, 'ATM', nx_global, ny_global, &
          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' , 'JRA55do', &
-               '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
@@ -764,8 +781,8 @@ subroutine datm_comp_run(gcomp, importState, exportState, target_ymd, target_tod
        select case (trim(datamode))
        case('CORE2_NYF','CORE2_IAF','CORE_IAF_JRA',&
             'CORE_RYF6162_JRA','CORE_RYF8485_JRA' ,&
-            'CORE_RYF9091_JRA','CORE_RYF0304_JRA','JRA55do' ,&
-            'CLMNCEP','CPLHIST','ERA5','GEFS','SIMPLE')
+            'CORE_RYF9091_JRA','CORE_RYF0304_JRA', 'JRA55do' ,&
+            '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

dglc/glc_comp_nuopc.F90

@@ -192,6 +192,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
     character(len=CS) :: cnum
     character(len=ESMF_MAXSTR) :: model_datafiles_list ! colon separated string containing input datafiles
     character(len=ESMF_MAXSTR) :: model_meshfiles_list ! colon separated string containing model meshfiles
+    type(shr_strdata_type)     :: sdat_dummy
     character(len=*),parameter :: subname=trim(module_name)//':(InitializeAdvertise) '
     !-------------------------------------------------------------------------------
 
@@ -210,7 +211,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
 
     ! Obtain flds_scalar values, mpi values, multi-instance values and
     ! set logunit and set shr logging to my log file
-    call dshr_init(gcomp, 'GLC', mpicom, my_task, inst_index, inst_suffix, &
+    call dshr_init(gcomp, sdat_dummy, 'GLC', mpicom, my_task, inst_index, inst_suffix, &
          flds_scalar_name, flds_scalar_num, flds_scalar_index_nx, flds_scalar_index_ny, logunit, rc)
     if (ChkErr(rc,__LINE__,u_FILE_u)) return
 

dice/ice_comp_nuopc.F90

@@ -197,7 +197,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
 
     ! Obtain flds_scalar values, mpi values, multi-instance values and
     ! set logunit and set shr logging to my log file
-    call dshr_init(gcomp, 'ICE', mpicom, my_task, inst_index, inst_suffix, &
+    call dshr_init(gcomp, sdat, 'ICE', mpicom, my_task, inst_index, inst_suffix, &
          flds_scalar_name, flds_scalar_num, flds_scalar_index_nx, flds_scalar_index_ny, &
          logunit, rc=rc)
     if (ChkErr(rc,__LINE__,u_FILE_u)) return
@@ -326,7 +326,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc)
 
     ! Initialize mesh, restart flag, logunit
     call ESMF_TraceRegionEnter('dice_strdata_init')
-    call dshr_mesh_init(gcomp, sdat, nullstr, logunit, 'ICE', nx_global, ny_global, &
+    call dshr_mesh_init(gcomp, nullstr, logunit, 'ICE', nx_global, ny_global, &
          model_meshfile, model_maskfile, model_mesh, model_mask, model_frac, restart_read, rc=rc)
     if (ChkErr(rc,__LINE__,u_FILE_u)) return
 

dlnd/lnd_comp_nuopc.F90

@@ -184,7 +184,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
 
     ! Obtain flds_scalar values, mpi values, multi-instance values and
     ! set logunit and set shr logging to my log file
-    call dshr_init(gcomp, 'LND', mpicom, my_task, inst_index, inst_suffix, &
+    call dshr_init(gcomp, sdat, 'LND', mpicom, my_task, inst_index, inst_suffix, &
          flds_scalar_name, flds_scalar_num, flds_scalar_index_nx, flds_scalar_index_ny, &
          logunit, rc=rc)
     if (ChkErr(rc,__LINE__,u_FILE_u)) return
@@ -288,7 +288,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc)
 
     ! Initialize sdat
     call ESMF_TraceRegionEnter('dlnd_strdata_init')
-    call dshr_mesh_init(gcomp, sdat, nullstr, logunit, 'LND', nx_global, ny_global, &
+    call dshr_mesh_init(gcomp, nullstr, logunit, 'LND', nx_global, ny_global, &
          model_meshfile, model_maskfile, model_mesh, model_mask, model_frac, restart_read, rc=rc)
 
     ! Initialize stream data type

docn/ocn_comp_nuopc.F90

@@ -218,7 +218,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
 
     ! Obtain flds_scalar values, mpi values, multi-instance values and
     ! set logunit and set shr logging to my log file
-    call dshr_init(gcomp, 'OCN', mpicom, my_task, inst_index, inst_suffix, &
+    call dshr_init(gcomp, sdat, 'OCN', mpicom, my_task, inst_index, inst_suffix, &
          flds_scalar_name, flds_scalar_num, flds_scalar_index_nx, flds_scalar_index_ny, logunit, rc)
     if (ChkErr(rc,__LINE__,u_FILE_u)) return
 
@@ -398,7 +398,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc)
        if (ChkErr(rc,__LINE__,u_FILE_u)) return
     end if
 
-    call dshr_mesh_init(gcomp, sdat, nullstr, logunit, 'OCN', nx_global, ny_global, &
+    call dshr_mesh_init(gcomp, nullstr, logunit, 'OCN', nx_global, ny_global, &
          model_meshfile, model_maskfile, model_mesh, model_mask, model_frac, restart_read, rc=rc)
     if (ChkErr(rc,__LINE__,u_FILE_u)) return
 

drof/rof_comp_nuopc.F90

@@ -183,7 +183,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
 
     ! Obtain flds_scalar values, mpi values, multi-instance values and
     ! set logunit and set shr logging to my log file
-    call dshr_init(gcomp, 'ROF', mpicom, my_task, inst_index, inst_suffix, &
+    call dshr_init(gcomp, sdat, 'ROF', mpicom, my_task, inst_index, inst_suffix, &
          flds_scalar_name, flds_scalar_num, flds_scalar_index_nx, flds_scalar_index_ny, &
          logunit, rc=rc)
     if (ChkErr(rc,__LINE__,u_FILE_u)) return
@@ -287,7 +287,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc)
 
     ! Initialize mesh, restart flag, logunit
     call ESMF_TraceRegionEnter('drof_strdata_init')
-    call dshr_mesh_init(gcomp, sdat, nullstr, logunit, 'ROF', nx_global, ny_global, &
+    call dshr_mesh_init(gcomp, nullstr, logunit, 'ROF', nx_global, ny_global, &
          model_meshfile, model_maskfile, model_mesh, model_mask, model_frac, restart_read, rc=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,175 @@
+module dshr_generic_mod
+
+  use ESMF            , only : ESMF_SUCCESS, ESMF_State, &
+                               ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_WARNING
+  use NUOPC           , only : NUOPC_Advertise
+  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(exportState, fldsExport, sdat, flds_scalar_name, rc)
+    type(ESMF_State)      , intent(inout) :: exportState
+    type(fldList_type),     pointer       :: fldsExport
+    type(shr_strdata_type), intent(in)    :: sdat
+    character(len=*)      , intent(in)    :: flds_scalar_name
+    integer               , intent(out)   :: rc
+
+    integer :: i, n
+    character(len=CL) :: fieldName
+    type(fldlist_type), pointer :: fldList
+
+    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
+    ! Handle cpl_scalars
+    call dshr_fldList_add(fldsExport, trim(flds_scalar_name))
+
+    fldlist => fldsExport ! the head of the linked list
+    do while (associated(fldlist))
+       call NUOPC_Advertise(exportState, standardName=fldlist%stdname, rc=rc)
+       if (ChkErr(rc,__LINE__,u_FILE_u)) return
+       call ESMF_LogWrite('(datm_generic_advertise): '//trim(fldList%stdname), ESMF_LOGMSG_INFO)
+       fldList => fldList%next
+    enddo
+
+  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