From 7edb08e15085c11155a0f0e0c7f2adcfb9a17be0 Mon Sep 17 00:00:00 2001 From: Andy Stokely Date: Wed, 5 Nov 2025 17:01:43 -0700 Subject: [PATCH 1/3] Add optional callback-based stream update configuration to mpas_init. --- src/driver/mpas_subdriver.F | 82 ++++++++++++++++++++++++++++++++++++- 1 file changed, 80 insertions(+), 2 deletions(-) diff --git a/src/driver/mpas_subdriver.F b/src/driver/mpas_subdriver.F index 68adea9dc3..64849aec6f 100644 --- a/src/driver/mpas_subdriver.F +++ b/src/driver/mpas_subdriver.F @@ -35,11 +35,78 @@ module mpas_subdriver use test_core_interface #endif + private :: make_stream_update_config + + interface stream_update_config_t + module procedure make_stream_update_config + end interface stream_update_config_t + + + type stream_update_config_t + !> Stream manager to be modified. + type(MPAS_streamManager_Type) :: manager + + !> Configuration filename associated with the update operation. + character(len = :), allocatable :: filename + + !> Procedure pointer implementing the update behavior. + procedure(apply_stream_update_i), pointer :: apply + end type stream_update_config_t + + + !----------------------------------------------------------------------- + ! abstract interface apply_stream_update_i + ! + !> \brief Interface for user-defined stream update routines. + !> + !> \details + !> Any procedure assigned to `stream_update_config_t%apply` must + !> match this interface. + !----------------------------------------------------------------------- + abstract interface + subroutine apply_stream_update_i(this, ierr) + import :: stream_update_config_t + class(stream_update_config_t), intent(inout) :: this + integer, intent(out), optional :: ierr + end subroutine apply_stream_update_i + end interface + contains - subroutine mpas_init(corelist, domain_ptr, external_comm, namelistFileParam, streamsFileParam) + !----------------------------------------------------------------------- + ! function make_stream_update_config + ! + !> \brief Construct and initialize a `stream_update_config_t` object. + !> \author Andy Stokely + !> \date 11/05/2025 + !> + !> \details + !> Returns a `stream_update_config_t` instance initialized using the + !> provided manager, filename, and update procedure pointer. + !----------------------------------------------------------------------- + type(stream_update_config_t) function make_stream_update_config( & + manager, filename, apply) result(stream_update_config) + implicit none + type(MPAS_streamManager_Type), intent(in) :: manager + character(len = *), intent(in), optional :: filename + procedure(apply_stream_update_i), pointer, intent(in) :: apply + + nullify(stream_update_config % apply) + stream_update_config % manager = manager + if (present(filename)) then + stream_update_config % filename = filename + else + stream_update_config % filename = '' + end if + stream_update_config % filename = filename + stream_update_config % apply => apply + end function make_stream_update_config + + + + subroutine mpas_init(corelist, domain_ptr, external_comm, namelistFileParam, streamsFileParam, stream_update_config) #ifdef MPAS_USE_MPI_F08 use mpi_f08, only : MPI_Comm @@ -63,6 +130,7 @@ subroutine mpas_init(corelist, domain_ptr, external_comm, namelistFileParam, str #endif character(len=*), intent(in), optional :: namelistFileParam character(len=*), intent(in), optional :: streamsFileParam + type(stream_update_config_t), intent(inout), optional :: stream_update_config integer :: iArg, nArgs logical :: readNamelistArg, readStreamsArg @@ -374,7 +442,17 @@ end subroutine xml_stream_get_attributes call mpas_log_write('xml stream parser failed: '//trim(domain_ptr % streams_filename), messageType=MPAS_LOG_CRIT) end if - ! + if (present(stream_update_config)) then + if (associated(stream_update_config % apply)) then + call stream_update_config % apply(ierr) + if (ierr /= 0) then + call mpas_log_write('Stream update procedure failed for core '//trim(domain_ptr % core % coreName), & + messageType=MPAS_LOG_CRIT) + end if + end if + + end if + ! ! Validate streams after set-up ! call mpas_log_write(' ** Validating streams') From 416d7c1b99f3c8be7bcac3f94f23bef7601dfcdf Mon Sep 17 00:00:00 2001 From: Andy Stokely Date: Tue, 11 Nov 2025 17:20:17 -0700 Subject: [PATCH 2/3] Updated stream callback type implementation to use an abstract class. This makes the derived type more generic and avoids using error prone, typeless constructs. --- src/driver/mpas_subdriver.F | 118 ++++++++++++++---------------------- 1 file changed, 45 insertions(+), 73 deletions(-) diff --git a/src/driver/mpas_subdriver.F b/src/driver/mpas_subdriver.F index 64849aec6f..bb5579394f 100644 --- a/src/driver/mpas_subdriver.F +++ b/src/driver/mpas_subdriver.F @@ -35,78 +35,53 @@ module mpas_subdriver use test_core_interface #endif - private :: make_stream_update_config - - interface stream_update_config_t - module procedure make_stream_update_config - end interface stream_update_config_t - - - type stream_update_config_t - !> Stream manager to be modified. - type(MPAS_streamManager_Type) :: manager - - !> Configuration filename associated with the update operation. - character(len = :), allocatable :: filename - - !> Procedure pointer implementing the update behavior. - procedure(apply_stream_update_i), pointer :: apply - end type stream_update_config_t - - - !----------------------------------------------------------------------- - ! abstract interface apply_stream_update_i + !*********************************************************************** ! - !> \brief Interface for user-defined stream update routines. - !> + ! type stream_update_callback_type + ! + !> \brief Abstract base class for stream update callbacks. + !> \author Andy Stokely + !> \date 11/11/2025 !> \details - !> Any procedure assigned to `stream_update_config_t%apply` must - !> match this interface. + !> Users extend this type to define custom behavior for updating + !> MPAS stream configurations. The deferred procedure "apply" is + !> implemented by the child derived type. + ! !----------------------------------------------------------------------- - abstract interface - subroutine apply_stream_update_i(this, ierr) - import :: stream_update_config_t - class(stream_update_config_t), intent(inout) :: this - integer, intent(out), optional :: ierr - end subroutine apply_stream_update_i - end interface - - + type, abstract :: stream_update_callback_type contains + procedure(stream_update_callback), private, deferred :: apply + procedure :: update + end type stream_update_callback_type - - !----------------------------------------------------------------------- - ! function make_stream_update_config + !*********************************************************************** + ! + ! interface stream_update_callback ! - !> \brief Construct and initialize a `stream_update_config_t` object. - !> \author Andy Stokely - !> \date 11/05/2025 - !> + !> \brief Interface for the deferred callback procedure. + !> \author Andy Stokely + !> \date 11/11/2025 !> \details - !> Returns a `stream_update_config_t` instance initialized using the - !> provided manager, filename, and update procedure pointer. + !> Implementations of this routine modify stream metadata within + !> the MPAS_streamManager_type. Errors should be signaled by setting + !> ierr to a non-zero value when present. + ! !----------------------------------------------------------------------- - type(stream_update_config_t) function make_stream_update_config( & - manager, filename, apply) result(stream_update_config) - implicit none - type(MPAS_streamManager_Type), intent(in) :: manager - character(len = *), intent(in), optional :: filename - procedure(apply_stream_update_i), pointer, intent(in) :: apply - - nullify(stream_update_config % apply) - stream_update_config % manager = manager - if (present(filename)) then - stream_update_config % filename = filename - else - stream_update_config % filename = '' - end if - stream_update_config % filename = filename - stream_update_config % apply => apply - end function make_stream_update_config - + abstract interface + subroutine stream_update_callback(self, manager, ierr) + import :: MPAS_streamManager_type + import :: stream_update_callback_type + + implicit none + class(stream_update_callback_type), intent(inout) :: self + type(MPAS_streamManager_type), intent(inout) :: manager + integer, optional, intent(out) :: ierr + end subroutine stream_update_callback + end interface + contains - subroutine mpas_init(corelist, domain_ptr, external_comm, namelistFileParam, streamsFileParam, stream_update_config) + subroutine mpas_init(corelist, domain_ptr, external_comm, namelistFileParam, streamsFileParam, streamUpdateCallback) #ifdef MPAS_USE_MPI_F08 use mpi_f08, only : MPI_Comm @@ -118,6 +93,7 @@ subroutine mpas_init(corelist, domain_ptr, external_comm, namelistFileParam, str use mpas_bootstrapping, only : mpas_bootstrap_framework_phase1, mpas_bootstrap_framework_phase2 use mpas_log use mpas_stream_inquiry, only : MPAS_stream_inquiry_new_streaminfo + use mpas_callback, only : stream_update_callback_type implicit none @@ -130,7 +106,7 @@ subroutine mpas_init(corelist, domain_ptr, external_comm, namelistFileParam, str #endif character(len=*), intent(in), optional :: namelistFileParam character(len=*), intent(in), optional :: streamsFileParam - type(stream_update_config_t), intent(inout), optional :: stream_update_config + class(stream_update_callback_type), intent(inout), optional :: streamUpdateCallback integer :: iArg, nArgs logical :: readNamelistArg, readStreamsArg @@ -442,17 +418,13 @@ end subroutine xml_stream_get_attributes call mpas_log_write('xml stream parser failed: '//trim(domain_ptr % streams_filename), messageType=MPAS_LOG_CRIT) end if - if (present(stream_update_config)) then - if (associated(stream_update_config % apply)) then - call stream_update_config % apply(ierr) - if (ierr /= 0) then - call mpas_log_write('Stream update procedure failed for core '//trim(domain_ptr % core % coreName), & - messageType=MPAS_LOG_CRIT) - end if - end if - + if ( present(streamUpdateCallback) ) then + call streamUpdateCallback%update(domain_ptr % streamManager, ierr) + if ( ierr /= 0 ) then + call mpas_log_write('Stream update callback failed for core '//trim(domain_ptr % core % coreName), messageType=MPAS_LOG_CRIT) end if - ! + end if + ! Validate streams after set-up ! call mpas_log_write(' ** Validating streams') From e8cabb7e0602b5b6dd4726028c15149229a37ee1 Mon Sep 17 00:00:00 2001 From: Andy Stokely Date: Wed, 12 Nov 2025 11:07:32 -0700 Subject: [PATCH 3/3] Removed update type bound method in stream_update_callback_type. --- src/driver/mpas_subdriver.F | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/driver/mpas_subdriver.F b/src/driver/mpas_subdriver.F index bb5579394f..dd10d5f36e 100644 --- a/src/driver/mpas_subdriver.F +++ b/src/driver/mpas_subdriver.F @@ -50,8 +50,7 @@ module mpas_subdriver !----------------------------------------------------------------------- type, abstract :: stream_update_callback_type contains - procedure(stream_update_callback), private, deferred :: apply - procedure :: update + procedure(stream_update_callback), deferred :: apply end type stream_update_callback_type !***********************************************************************