diff --git a/datm/atm_comp_nuopc.F90 b/datm/atm_comp_nuopc.F90 index 5758916a6..723c1d865 100644 --- a/datm/atm_comp_nuopc.F90 +++ b/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 diff --git a/dshr/CMakeLists.txt b/dshr/CMakeLists.txt index 5e29eb600..597aa6d83 100644 --- a/dshr/CMakeLists.txt +++ b/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}") diff --git a/dshr/dshr_generic_mod.F90 b/dshr/dshr_generic_mod.F90 new file mode 100644 index 000000000..6cf832ff7 --- /dev/null +++ b/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 diff --git a/streams/dshr_strdata_mod.F90 b/streams/dshr_strdata_mod.F90 index 1b1529e3b..ae20a4ac2 100644 --- a/streams/dshr_strdata_mod.F90 +++ b/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 !===============================================================================