From 71b855de4ca0e68423ee01283fba24c60b31098b Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Tue, 24 Mar 2026 12:25:26 -0700 Subject: [PATCH] Create a core interface function to facilitate computed dimensions Currently there is no way of defining a dimension that is derived from preexisting values already present in input data. Various calls in the registry generated code require that state variables that would need a runtime-defined dimension exist prior to their usage and thus prior to the end of the bootstrapping sequence. As such, it is not feasible to have a core-only implementation of injecting a runtime computed dimension at the appropriate time of setup. This adds a methodology for cores to provide core-specific computed dimensions implementations by adding: 1. an interface subroutine to the core type 2. a computed dimensions interface types and module 3. invocation of new optional core interface function in bootstrapping The computed dimensions interface types and modules are based off of the same pattern used for decomposed dimensions. --- src/framework/Makefile | 3 + src/framework/mpas_bootstrapping.F | 69 +++++++ src/framework/mpas_compute_dim.F | 224 +++++++++++++++++++++++ src/framework/mpas_compute_dim_types.inc | 19 ++ src/framework/mpas_core_types.inc | 10 + src/framework/mpas_derived_types.F | 2 + 6 files changed, 327 insertions(+) create mode 100644 src/framework/mpas_compute_dim.F create mode 100644 src/framework/mpas_compute_dim_types.inc diff --git a/src/framework/Makefile b/src/framework/Makefile index 2d8e7dc92b..0cf9ff305b 100644 --- a/src/framework/Makefile +++ b/src/framework/Makefile @@ -15,6 +15,7 @@ OBJS = mpas_kind_types.o \ mpas_block_creator.o \ mpas_dmpar.o \ mpas_abort.o \ + mpas_compute_dim.o \ mpas_decomp.o \ mpas_threading.o \ mpas_io.o \ @@ -73,6 +74,8 @@ mpas_field_routines.o: mpas_derived_types.o duplicate_field_array.inc duplicate_ mpas_pool_routines.o: mpas_derived_types.o mpas_field_routines.o mpas_threading.o mpas_log.o +mpas_compute_dim.o: mpas_kind_types.o mpas_derived_types.o mpas_stream_manager.o mpas_log.o + mpas_decomp.o: mpas_derived_types.o mpas_stream_manager.o mpas_log.o mpas_hash.o : mpas_derived_types.o diff --git a/src/framework/mpas_bootstrapping.F b/src/framework/mpas_bootstrapping.F index 4241255e2a..8cfd90902d 100644 --- a/src/framework/mpas_bootstrapping.F +++ b/src/framework/mpas_bootstrapping.F @@ -671,6 +671,13 @@ subroutine mpas_bootstrap_framework_phase2(domain, pio_file_desc) !{{{ call mpas_pool_set_error_level(err_level) + ! Compute any dimensions that were not read in but can be created by the core + if ( associated(domain % core % setup_computed_dimensions) ) then + call mpas_log_write('----- setting up computed dimensions -----') + call calculate_computed_dimensions(domain % streamManager, domain % blocklist, readableDimensions) + call mpas_log_write('----- done setting up computed dimensions -----') + end if + ! Allocate blocks, and copy indexTo arrays into blocks call mpas_block_creator_finalize_block_phase2(domain % streamManager, domain % blocklist, readableDimensions) call mpas_link_fields(domain) @@ -1070,4 +1077,66 @@ subroutine get_dimlist_for_field(allFields, fieldName, dimNames)!{{{ end subroutine get_dimlist_for_field!}}} + + !*********************************************************************** + ! + ! routine calculate_computed_dimensions + ! + !> \brief Runs through the compute_dim_list functions provided by a core + !> \author Anthony Islas + !> \date 06 March 2026 + !> \details + !> This subroutine creates a local mpas_compute_dim_list to gather the + !> functions provided for this core to compute the respective dimensions + !> associated with each function. This list is looped over, and if the + !> dimension already exists within readableDimensions, it is assumed + !> already resolved and skipped. If not present in readableDimensions + !> the function is invoked. + !> + !> It is the responsibility of the called function to add the dimension + !> to the readableDimensions pool. + !> + !> At the end of this call, readableDimensions should contain the combined + !> set of original values and any new dimensions a core specifies to be + !> resolved by a computing function that were not already in readableDimensions. + ! + !----------------------------------------------------------------------- + subroutine calculate_computed_dimensions(streamManager, blocklist, readableDimensions)!{{{ + + use mpas_stream_manager + use mpas_compute_dim + + type (mpas_streamManager_type), pointer :: streamManager !< Input: Stream manager structure + type (block_type), pointer :: blocklist !< Input/Output: Linked List of blocks + type (mpas_pool_type), intent(inout) :: readableDimensions + + type (domain_type), pointer :: domain + type (mpas_compute_dim_list), pointer :: computeDimList => null(), cursor => null() + integer, pointer :: readDim + integer :: err_local + + domain => blocklist % domain + call mpas_compute_dim_create_compute_dim_list(computeDimList) + + err_local = domain % core % setup_computed_dimensions(computeDimList) + cursor => computeDimList + + do while (associated(cursor)) + if (cursor % nameLen > 0) then + call mpas_log_write('Checking if ' // trim(cursor % dimName) // ' exists...') + call mpas_pool_get_dimension(readableDimensions, cursor % dimName, readDim) + if (.not. associated(readDim)) then + err_local = cursor % compDimFunc(streamManager, blocklist, readableDimensions) + else + call mpas_log_write('Computed diminsion ' // trim(cursor % dimName) // ' already read in', MPAS_LOG_WARN) + end if + end if + cursor => cursor % next + end do + + call mpas_compute_dim_destroy_compute_dim_list(computeDimList) + + end subroutine calculate_computed_dimensions!}}} + + end module mpas_bootstrapping diff --git a/src/framework/mpas_compute_dim.F b/src/framework/mpas_compute_dim.F new file mode 100644 index 0000000000..b334bfb612 --- /dev/null +++ b/src/framework/mpas_compute_dim.F @@ -0,0 +1,224 @@ +! Copyright (c) 2026, Los Alamos National Security, LLC (LANS) +! and the University Corporation for Atmospheric Research (UCAR). +! +! Unless noted otherwise source code is licensed under the BSD license. +! Additional copyright and license information can be found in the LICENSE file +! distributed with this code, or at http://mpas-dev.github.com/license.html +! +!----------------------------------------------------------------------- +! mpas_compute_dim +! +!> \brief MPAS Compute Dimensions +!> \author Anthony Islas +!> \date 02/17/2026 +!> \details +!> This module will contain the mpas_compute_dim_list type, along with routines +!> to register and access a computed dimension function. +! +!----------------------------------------------------------------------- + +module mpas_compute_dim + + use mpas_kind_types + use mpas_derived_types + use mpas_stream_manager + use mpas_log + + implicit none + + contains + + +!----------------------------------------------------------------------- +! routine mpas_compute_dim_create_compute_dim_list +! +!> \brief MPAS compute_dim list create routine +!> \author Anthony Islas +!> \date 02/17/2026 +!> \details +!> This routine creates a computed dimension list. +! +!----------------------------------------------------------------------- + subroutine mpas_compute_dim_create_compute_dim_list(computeDimList)!{{{ + type (mpas_compute_dim_list), pointer :: computeDimList + + integer :: errLocal + + if ( .not. associated(computeDimList) ) then + allocate(computeDimList) + computeDimList % dimName = '' + computeDimList % nameLen = -1 + nullify(computeDimList % compDimFunc) + nullify(computeDimList % next) + end if + + end subroutine!}}} + + +!----------------------------------------------------------------------- +! routine mpas_compute_dim_destroy_compute_dim_list +! +!> \brief MPAS compute_dim list destruction routine +!> \author Anthony Islas +!> \date 02/17/2026 +!> \details +!> This routine destroys a computed dimension list. +! +!----------------------------------------------------------------------- + subroutine mpas_compute_dim_destroy_compute_dim_list(computeDimList)!{{{ + type (mpas_compute_dim_list), pointer :: computeDimList + + type (mpas_compute_dim_list), pointer :: cursor + + do while (associated(computeDimList % next)) + cursor => computeDimList % next + + if ( associated(cursor % next) ) then + computeDimList % next => cursor % next + else + nullify(computeDimList % next) + end if + + deallocate(cursor) + end do + + deallocate(computeDimList) + end subroutine mpas_compute_dim_destroy_compute_dim_list!}}} + + +!----------------------------------------------------------------------- +! routine mpas_compute_dim_register_method +! +!> \brief MPAS compute_dim list register routine +!> \author Anthony Islas +!> \date 02/17/2026 +!> \details +!> This routine registers a computed dimension function in a computed dimension list. +!> If present, the optional argument iErr is set to 1 if +!> the function is already registered and to 0 otherwise. +! +!----------------------------------------------------------------------- + subroutine mpas_compute_dim_register_method(computeDimList, dimName, compDimFunc, iErr)!{{{ + type (mpas_compute_dim_list), pointer :: computeDimList + character (len=*), intent(in) :: dimName + procedure (mpas_compute_dim_function), pointer :: compDimFunc + integer, intent(out) :: iErr + + type (mpas_compute_dim_list), pointer :: cursor + type (mpas_compute_dim_list), pointer :: cursorPrev + integer :: nameLen + + iErr = 0 + + nameLen = len_trim(dimName) + + cursor => computeDimList + nullify(cursorPrev) + do while (associated(cursor)) + if ( nameLen == cursor % nameLen ) then + if ( trim(dimName) == trim(cursor % dimName) ) then + call mpas_log_write('Computed dimension ' // trim(dimName) // ' is already registered.') + iErr = 1 + return + end if + end if + cursorPrev => cursor + cursor => cursor % next + end do + + cursor => cursorPrev + + allocate(cursor % next) + cursor => cursor % next + cursor % dimName = dimName + cursor % compDimFunc => compDimFunc + cursor % nameLen = nameLen + nullify(cursor % next) + end subroutine mpas_compute_dim_register_method!}}} + + +!----------------------------------------------------------------------- +! routine mpas_compute_dim_get_method +! +!> \brief MPAS compute_dim list query routine +!> \author Anthony Islas +!> \date 02/17/2026 +!> \details +!> This routine querys a computed dimension list for a specific computed dimension function. +!> If present, the optional argument iErr is set to 1 if +!> the requested function is not found and to 0 otherwise. +! +!----------------------------------------------------------------------- + subroutine mpas_compute_dim_get_method(computeDimList, dimName, compDimFunc, iErr)!{{{ + type (mpas_compute_dim_list), pointer :: computeDimList + character (len=*), intent(in) :: dimName + procedure (mpas_compute_dim_function), pointer :: compDimFunc + integer, intent(out) :: iErr + + type (mpas_compute_dim_list), pointer :: cursor + integer :: nameLen + + iErr = 0 + + nameLen = len_trim(dimName) + + cursor => computeDimList + do while (associated(cursor)) + if ( nameLen == cursor % nameLen ) then + if ( trim(cursor % dimName) == trim(dimName) ) then + compDimFunc => cursor % compDimFunc + return + end if + end if + cursor => cursor % next + end do + + iErr = 1 + call mpas_log_write('Computed dimension '//trim(dimName)//' not found in computed dimension list.') + + end subroutine mpas_compute_dim_get_method!}}} + + +!----------------------------------------------------------------------- +! routine mpas_compute_dim_remove_method +! +!> \brief MPAS compute_dim list removal routine +!> \author Anthony Islas +!> \date 02/17/2026 +!> \details +!> This routine removes a specific computed dimension function from a computed dimension list. +! +!----------------------------------------------------------------------- + subroutine mpas_compute_dim_remove_method(computeDimList, dimName, iErr)!{{{ + type (mpas_compute_dim_list), pointer :: computeDimList + character (len=*), intent(in) :: dimName + integer, intent(out) :: iErr + + integer :: nameLen + type (mpas_compute_dim_list), pointer :: cursor, cursorPrev + + iErr = 0 + + nameLen = len_trim(dimName) + + cursor => computeDimList + nullify(cursorPrev) + do while (associated(cursor)) + if ( nameLen == cursor % nameLen ) then + if ( trim(cursor % dimName) == trim(dimName) ) then + if ( associated(cursor % next) ) then + cursorPrev % next => cursor % next + else + nullify(cursorPrev % next) + end if + + deallocate(cursor) + return + end if + end if + cursorPrev => cursor + cursor => cursor % next + end do + end subroutine mpas_compute_dim_remove_method!}}} + +end module mpas_compute_dim diff --git a/src/framework/mpas_compute_dim_types.inc b/src/framework/mpas_compute_dim_types.inc new file mode 100644 index 0000000000..7206569554 --- /dev/null +++ b/src/framework/mpas_compute_dim_types.inc @@ -0,0 +1,19 @@ + abstract interface + function mpas_compute_dim_function(streamManager, blocklist, readDimensions) result(ierr) + import mpas_streamManager_type + import mpas_pool_type + import block_type + + type (mpas_streamManager_type), intent(inout) :: streamManager + type (block_type), pointer :: blocklist + type (mpas_pool_type), intent(inout) :: readDimensions + integer :: ierr + end function + end interface + + type mpas_compute_dim_list + integer :: nameLen + character (len=StrKIND) :: dimName + procedure (mpas_compute_dim_function), pointer, nopass :: compDimFunc => null() + type (mpas_compute_dim_list), pointer :: next => null() + end type mpas_compute_dim_list diff --git a/src/framework/mpas_core_types.inc b/src/framework/mpas_core_types.inc index 15a9866ccd..c9d2659b6d 100644 --- a/src/framework/mpas_core_types.inc +++ b/src/framework/mpas_core_types.inc @@ -34,6 +34,15 @@ end function mpas_setup_packages_function end interface + abstract interface + function mpas_setup_computed_dimensions_function(computeDimList) result(iErr) + import mpas_compute_dim_list + + type (mpas_compute_dim_list), pointer :: computeDimList + integer :: iErr + end function mpas_setup_computed_dimensions_function + end interface + abstract interface function mpas_setup_decompositions_function(decompList) result(iErr) import mpas_decomp_list @@ -170,6 +179,7 @@ procedure (mpas_setup_namelist_function), pointer, nopass :: setup_namelist => null() procedure (mpas_define_packages_function), pointer, nopass :: define_packages => null() procedure (mpas_setup_packages_function), pointer, nopass :: setup_packages => null() + procedure (mpas_setup_computed_dimensions_function), pointer, nopass :: setup_computed_dimensions => null() procedure (mpas_setup_decompositions_function), pointer, nopass :: setup_decompositions => null() procedure (mpas_get_mesh_stream_function), pointer, nopass :: get_mesh_stream => null() procedure (mpas_setup_clock_function), pointer, nopass :: setup_clock => null() diff --git a/src/framework/mpas_derived_types.F b/src/framework/mpas_derived_types.F index 9995fd147e..4478175143 100644 --- a/src/framework/mpas_derived_types.F +++ b/src/framework/mpas_derived_types.F @@ -74,6 +74,8 @@ module mpas_derived_types #include "mpas_block_types.inc" +#include "mpas_compute_dim_types.inc" + #include "mpas_decomp_types.inc" #include "mpas_stream_inquiry_types.inc"