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"