From 49bbf7900c87270926197768bd050c7b461a8e55 Mon Sep 17 00:00:00 2001 From: Amidu Oloso Date: Tue, 14 Jan 2025 16:54:53 -0500 Subject: [PATCH 01/15] still trying to fix GOCART2G array indexing --- generic/OpenMP_Support.F90 | 22 ++++++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) diff --git a/generic/OpenMP_Support.F90 b/generic/OpenMP_Support.F90 index 9cdf0a3ac1c8..661b5b0ace9a 100644 --- a/generic/OpenMP_Support.F90 +++ b/generic/OpenMP_Support.F90 @@ -6,6 +6,7 @@ module MAPL_OpenMP_Support use MAPL_maplgrid use MAPL_ExceptionHandling use mapl_KeywordEnforcerMod + use MAPL_BaseMod, only : MAPL_Grid_Interior !$ use omp_lib implicit none @@ -83,7 +84,7 @@ function make_subgrids_from_bounds(primary_grid, bounds, unusable, rc) result(su type(Interval), intent(in) :: bounds(:) class(KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc - integer :: local_count(3) + integer :: local_count(3), global_count(3) integer :: status integer :: petMap(1,1,1) integer :: myPet, section, i, j, k, count, size_ @@ -102,7 +103,7 @@ function make_subgrids_from_bounds(primary_grid, bounds, unusable, rc) result(su !end do allocate(subgrids(size(bounds))) - call MAPL_GridGet(primary_grid,localcellcountPerDim=local_count, _RC) + call MAPL_GridGet(primary_grid,localcellcountPerDim=local_count, globalCellCountPerDim=global_count, _RC) call ESMF_VMGetCurrent(vm, _RC) call ESMF_VMGet(vm, localPET=myPET, _RC) @@ -175,6 +176,23 @@ function make_subgrids_from_bounds(primary_grid, bounds, unusable, rc) result(su itemCount = count, valueList=lons1d, _RC) call ESMF_AttributeSet(subgrids(i), name='GridCornerLats:', & itemCount = count, valueList=lats1d, _RC) + block + integer :: global_grid_info(10) + integer :: i1,i2,j1,j2 + call MAPL_Grid_Interior(primary_grid,i1,i2,j1,j2) + global_grid_info(1:3) = global_count + !global_grid_info(4:6) = local_count + global_grid_info(4) = size(new_lons,1) + global_grid_info(5) = size(new_lons,2) + global_grid_info(6) = local_count(3) + global_grid_info(7) = i1 + global_grid_info(8) = i2 + global_grid_info(9) = j1 + bounds(i)%min - 1 + global_grid_info(10) = j1 + bounds(i)%max - 1 + print '(a,i6,6i4)', __FILE__, __LINE__, myPet, i, j1, j2, global_grid_info(9), global_grid_info(10) + call ESMF_AttributeSet(subgrids(i), name="GLOBAL_GRID_INFO", & + itemCount=10, valueList=global_grid_info, _RC) + end block deallocate(lons1d, lats1d) deallocate(new_corner_lons, new_corner_lats) From ef5e0245d69388c971174b34faab7a66db820958 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 15 Jan 2025 11:31:47 -0500 Subject: [PATCH 02/15] more updates --- base/Base/Base_Base_implementation.F90 | 60 ++++++++++++++++++++------ base/MaplGrid.F90 | 9 ++++ 2 files changed, 57 insertions(+), 12 deletions(-) diff --git a/base/Base/Base_Base_implementation.F90 b/base/Base/Base_Base_implementation.F90 index b50e84e98897..6653bf2e38fa 100644 --- a/base/Base/Base_Base_implementation.F90 +++ b/base/Base/Base_Base_implementation.F90 @@ -1557,11 +1557,24 @@ module subroutine MAPL_GRID_INTERIOR(GRID,I1,IN,J1,JN) integer :: gridRank integer, allocatable :: localDeToDeMap(:) integer :: rc + logical :: isPresent + integer :: global_grid_info(10) i1=-1 j1=-1 in=-1 jn=-1 + + call ESMF_AttributeGet(grid, name="GLOBAL_GRID_INFO", isPresent=isPresent, _RC) + if (isPresent) then + call ESMF_AttributeGet(grid, name="GLOBAL_GRID_INFO", valueList=global_grid_info, _RC) + I1 = global_grid_info(7) + IN = global_grid_info(8) + j1 = global_grid_info(9) + JN = global_grid_info(10) + _RETURN(_SUCCESS) + end if + call ESMF_GridGet (GRID, dimCount=gridRank, distGrid=distGrid, _RC) call ESMF_DistGridGet(distGRID, delayout=layout, _RC) call ESMF_DELayoutGet(layout, deCount = nDEs, localDeCount=localDeCount,_RC) @@ -2138,6 +2151,24 @@ module subroutine MAPL_GridGetInterior(GRID,I1,IN,J1,JN) integer :: deId integer :: gridRank integer :: rc + logical :: isPresent + integer :: global_grid_info(10) + + i1=-1 + j1=-1 + in=-1 + jn=-1 + + call ESMF_AttributeGet(grid, name="GLOBAL_GRID_INFO", isPresent=isPresent, _RC) + if (isPresent) then + call ESMF_AttributeGet(grid, name="GLOBAL_GRID_INFO", valueList=global_grid_info, _RC) + I1 = global_grid_info(7) + IN = global_grid_info(8) + j1 = global_grid_info(9) + JN = global_grid_info(10) + _RETURN(_SUCCESS) + end if + call ESMF_GridGet (GRID, dimCount=gridRank, distGrid=distGrid, _RC) call ESMF_DistGridGet(distGRID, delayout=layout, _RC) @@ -2627,9 +2658,9 @@ module subroutine MAPL_GetHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid, rc) tmp_lats = latR8 end if -!AOO change tusing GridType atribute if (im_world*6==jm_world) then - call ESMF_AttributeGet(grid, name='GridType', value=grid_type, _RC) - if(trim(grid_type) == "Cubed-Sphere") then + if (im_world*6==jm_world) then +! call ESMF_AttributeGet(grid, name='GridType', value=grid_type, _RC) +! if(trim(grid_type) == "Cubed-Sphere") then call MAPL_GetGlobalHorzIJIndex(npts, II, JJ, lon=lon, lat=lat, lonR8=lonR8, latR8=latR8, Grid=Grid, _RC) @@ -2868,28 +2899,33 @@ function grid_is_ok(grid) result(OK) type(ESMF_Grid), intent(inout) :: grid logical :: OK integer :: I1, I2, J1, J2, j - real(ESMF_KIND_R8), pointer :: corner_lons(:,:), corner_lats(:,:) + real(ESMF_KIND_R8), allocatable :: corner_lons(:,:), corner_lats(:,:) real(ESMF_KIND_R8), allocatable :: lonRe(:), latRe(:) real(ESMF_KIND_R8), allocatable :: accurate_lat(:), accurate_lon(:) real(ESMF_KIND_R8) :: stretch_factor, target_lon, target_lat, shift0 real :: tolerance + integer :: local_dims(3) tolerance = epsilon(1.0) call MAPL_GridGetInterior(grid,I1,I2,J1,J2) + call MAPL_GridGet(grid, localCellCountPerDim=local_dims, _RC) OK = .true. ! check the edge of face 1 along longitude - call ESMF_GridGetCoord(grid,localDE=0,coordDim=1,staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=corner_lons, rc=status) - call ESMF_GridGetCoord(grid,localDE=0,coordDim=2,staggerloc=ESMF_STAGGERLOC_CORNER, & - farrayPtr=corner_lats, rc=status) + !call ESMF_GridGetCoord(grid,localDE=0,coordDim=1,staggerloc=ESMF_STAGGERLOC_CORNER, & + ! farrayPtr=corner_lons, _RC) + !call ESMF_GridGetCoord(grid,localDE=0,coordDim=2,staggerloc=ESMF_STAGGERLOC_CORNER, & + ! farrayPtr=corner_lats, _RC) + allocate(corner_lons(local_dims(1)+1, local_dims(2)+1)) + allocate(corner_lats(local_dims(1)+1, local_dims(2)+1)) + call MAPL_GridGetCorners(grid, corner_lons, corner_lats, _RC) if ( I1 == 1 .and. J1 == 1 ) then - allocate(lonRe(j2-j1+1), latRe(j2-j1+1)) - call MAPL_Reverse_Schmidt(grid, stretched, J2-J1+1, lonR8=corner_lons(1,:), & - latR8=corner_lats(1,:), lonRe=lonRe, latRe=latRe, _RC) + allocate(lonRe(local_dims(2)), latRe(local_dims(2))) + call MAPL_Reverse_Schmidt(grid, stretched, local_dims(2), lonR8=corner_lons(1,1:local_dims(2)), & + latR8=corner_lats(1,1:local_dims(2)), lonRe=lonRe, latRe=latRe, _RC) - allocate(accurate_lon(j2-j1+1), accurate_lat(j2-j1+1)) + allocate(accurate_lon(local_dims(2)), accurate_lat(local_dims(2))) shift0 = shift if (stretched) shift0 = 0 diff --git a/base/MaplGrid.F90 b/base/MaplGrid.F90 index fdac6371357e..153fdd11d865 100644 --- a/base/MaplGrid.F90 +++ b/base/MaplGrid.F90 @@ -265,10 +265,19 @@ subroutine MAPL_GridGet(GRID, globalCellCountPerDim, localCellCountPerDim, layou type(ESMF_DistGrid) :: distGrid integer, allocatable :: maxindex(:,:),minindex(:,:) integer, pointer :: ims(:),jms(:) + integer :: global_grid_info(10) pglobal = present(globalCellCountPerDim) plocal = present(localCellCountPerDim) + call ESMF_AttributeGet(grid, name="GLOBAL_GRID_INFO", isPresent=isPresent, _RC) + if (isPresent) then + call ESMF_AttributeGet(grid, name="GLOBAL_GRID_INFO", valueList=global_grid_info, _RC) + if (pglobal) globalCellCountPerDim = global_grid_info(1:3) + if (plocal) localCellCountPerDim = global_grid_info(4:6) + _RETURN(_SUCCESS) + end if + if (pglobal .or. plocal) then call ESMF_GridGet(grid, dimCount=gridRank, _RC) From 08bd7473eb848a8f4d92da8730e03421f56fa09f Mon Sep 17 00:00:00 2001 From: Amidu Oloso Date: Fri, 17 Jan 2025 12:09:37 -0500 Subject: [PATCH 03/15] removed unnecessary comments --- base/Base/Base_Base_implementation.F90 | 2 -- generic/OpenMP_Support.F90 | 1 - 2 files changed, 3 deletions(-) diff --git a/base/Base/Base_Base_implementation.F90 b/base/Base/Base_Base_implementation.F90 index 6653bf2e38fa..c04decee1501 100644 --- a/base/Base/Base_Base_implementation.F90 +++ b/base/Base/Base_Base_implementation.F90 @@ -2659,8 +2659,6 @@ module subroutine MAPL_GetHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid, rc) end if if (im_world*6==jm_world) then -! call ESMF_AttributeGet(grid, name='GridType', value=grid_type, _RC) -! if(trim(grid_type) == "Cubed-Sphere") then call MAPL_GetGlobalHorzIJIndex(npts, II, JJ, lon=lon, lat=lat, lonR8=lonR8, latR8=latR8, Grid=Grid, _RC) diff --git a/generic/OpenMP_Support.F90 b/generic/OpenMP_Support.F90 index 661b5b0ace9a..9a9c33b629b1 100644 --- a/generic/OpenMP_Support.F90 +++ b/generic/OpenMP_Support.F90 @@ -189,7 +189,6 @@ function make_subgrids_from_bounds(primary_grid, bounds, unusable, rc) result(su global_grid_info(8) = i2 global_grid_info(9) = j1 + bounds(i)%min - 1 global_grid_info(10) = j1 + bounds(i)%max - 1 - print '(a,i6,6i4)', __FILE__, __LINE__, myPet, i, j1, j2, global_grid_info(9), global_grid_info(10) call ESMF_AttributeSet(subgrids(i), name="GLOBAL_GRID_INFO", & itemCount=10, valueList=global_grid_info, _RC) end block From 46c64734614bb3504dfe3e38adfd483d8d5b7de6 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 22 Jan 2025 10:29:03 -0500 Subject: [PATCH 04/15] Update to ESMA_env v4.34.1 --- CHANGELOG.md | 6 +++++- components.yaml | 2 +- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 643edd7ab418..8ef520106474 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,11 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed +- Updated ExtData so that if files are missing in a sequence the last value will be perisisted if one has not chosen `exact` option +- Update `components.yaml` + - `ESMA_env` v4.34.1 + - Fix GEOSpyD module on GMAO Desktops + ### Fixed ### Removed @@ -31,7 +36,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed -- Updated ExtData so that if files are missing in a sequence the last value will be perisisted if one has not chosen `exact` option - Changed MAPL_ESMFRegridder to require the dstMaskValues to be added as grid attribute to use fixed masking, fixes UFS issue - Increased formatting width of time index in ExtData2G diagnostic print - Updated GitHub checkout action to use blobless clones diff --git a/components.yaml b/components.yaml index bedab2379e88..27bfcc960af7 100644 --- a/components.yaml +++ b/components.yaml @@ -5,7 +5,7 @@ MAPL: ESMA_env: local: ./ESMA_env remote: ../ESMA_env.git - tag: v4.34.0 + tag: v4.34.1 develop: main ESMA_cmake: From 6bfafd9ecfb00606f9fa5933c051635ea62d52c4 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 22 Jan 2025 10:44:04 -0500 Subject: [PATCH 05/15] fix changlog and remove prints --- CHANGELOG.md | 3 +-- gridcomps/ExtData2G/ExtDataBracket.F90 | 2 -- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 643edd7ab418..64ca8a4610ba 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added ### Changed +- Updated ExtData so that if files are missing in a sequence the last value will be perisisted if one has not chosen `exact` option ### Fixed @@ -31,8 +32,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed -- Updated ExtData so that if files are missing in a sequence the last value will be perisisted if one has not chosen `exact` option -- Changed MAPL_ESMFRegridder to require the dstMaskValues to be added as grid attribute to use fixed masking, fixes UFS issue - Increased formatting width of time index in ExtData2G diagnostic print - Updated GitHub checkout action to use blobless clones - Update CI to use Baselibs 7.29.0 by default diff --git a/gridcomps/ExtData2G/ExtDataBracket.F90 b/gridcomps/ExtData2G/ExtDataBracket.F90 index 9fff7624bbb3..8c8c84da4f7f 100644 --- a/gridcomps/ExtData2G/ExtDataBracket.F90 +++ b/gridcomps/ExtData2G/ExtDataBracket.F90 @@ -188,8 +188,6 @@ subroutine interpolate_to_time(this,field,time,rc) right_node_set = this%right_node%check_if_initialized(_RC) left_node_set = this%left_node%check_if_initialized(_RC) - call ESMF_TimePrint(this%left_node%time,options='string',preString='left bracket time: ') - call ESMF_TimePrint(this%right_node%time,options='string',preString='right bracket time: ') alpha = 0.0 if ( (.not.this%disable_interpolation) .and. (.not.this%intermittent_disable) .and. right_node_set .and. left_node_set) then From f306557e9d4dc871344e913c7ca09a4c0bfd493b Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Wed, 22 Jan 2025 13:05:48 -0500 Subject: [PATCH 06/15] restore missing line in changelog --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 64ca8a4610ba..ef026ba9b20a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -32,6 +32,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed +- Changed MAPL_ESMFRegridder to require the dstMaskValues to be added as grid attribute to use fixed masking, fixes UFS issue - Increased formatting width of time index in ExtData2G diagnostic print - Updated GitHub checkout action to use blobless clones - Update CI to use Baselibs 7.29.0 by default From b2aa81733b74a0ca35cfa5688c54cc152d0ca6c9 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 22 Jan 2025 18:13:28 -0500 Subject: [PATCH 07/15] Fix up changelog --- CHANGELOG.md | 1 - 1 file changed, 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index f99a4931799e..8ef520106474 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,7 +10,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added ### Changed -- Updated ExtData so that if files are missing in a sequence the last value will be perisisted if one has not chosen `exact` option - Updated ExtData so that if files are missing in a sequence the last value will be perisisted if one has not chosen `exact` option - Update `components.yaml` From 03db82d3294e7e7986d103a039ed0cba3c6781c0 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Wed, 22 Jan 2025 11:11:44 -0500 Subject: [PATCH 08/15] Compiles. --- generic3g/specs/CMakeLists.txt | 2 + generic3g/specs/ClassAspect.F90 | 57 +++++++++++++++++++++++-- generic3g/specs/FieldSpec.F90 | 36 ++++++++-------- generic3g/specs/GeomAspect.F90 | 1 + generic3g/specs/UngriddedDimsAspect.F90 | 18 +++++++- generic3g/specs/UnitsAspect.F90 | 18 +++++++- generic3g/specs/VerticalGridAspect.F90 | 30 ++++++++++++- 7 files changed, 138 insertions(+), 24 deletions(-) diff --git a/generic3g/specs/CMakeLists.txt b/generic3g/specs/CMakeLists.txt index d3282bd2dd83..6ee60dd08930 100644 --- a/generic3g/specs/CMakeLists.txt +++ b/generic3g/specs/CMakeLists.txt @@ -2,6 +2,8 @@ target_sources(MAPL.generic3g PRIVATE AspectId.F90 StateItemAspect.F90 ClassAspect.F90 + FieldClassAspect.F90 + AspectCollection.F90 AttributesAspect.F90 GeomAspect.F90 diff --git a/generic3g/specs/ClassAspect.F90 b/generic3g/specs/ClassAspect.F90 index bcc865338951..34a9e5006520 100644 --- a/generic3g/specs/ClassAspect.F90 +++ b/generic3g/specs/ClassAspect.F90 @@ -1,6 +1,6 @@ #include "MAPL_Generic.h" -module mapl3_ClassAspect +module mapl3g_ClassAspect use mapl3g_AspectId use mapl3g_StateItemAspect use mapl_ErrorHandling @@ -17,11 +17,60 @@ module mapl3_ClassAspect type, abstract, extends(StateItemAspect) :: ClassAspect contains - procedure, nopass :: get_aspect_id + procedure(I_create), deferred :: create + procedure(I_destroy), deferred :: destroy + procedure(I_allocate), deferred :: allocate + + procedure(I_add_to_state), deferred :: add_to_state + procedure(I_add_to_bundle), deferred :: add_to_bundle + procedure, non_overridable, nopass :: get_aspect_id end type ClassAspect -contains + abstract interface + + ! Will use ESMF so cannot be PURE + subroutine I_create(this, rc) + import ClassAspect + class(ClassAspect), intent(inout) :: this + integer, optional, intent(out) :: rc + end subroutine I_create + + subroutine I_destroy(this, rc) + import ClassAspect + class(ClassAspect), intent(inout) :: this + integer, optional, intent(out) :: rc + end subroutine I_destroy + + ! Will use ESMF so cannot be PURE + subroutine I_allocate(this, other_aspects, rc) + import ClassAspect + import AspectMap + class(ClassAspect), intent(inout) :: this + type(AspectMap), intent(in) :: other_aspects + integer, optional, intent(out) :: rc + end subroutine I_allocate + + subroutine I_add_to_state(this, multi_state, actual_pt, rc) + use mapl3g_MultiState + use mapl3g_ActualConnectionPt + import ClassAspect + class(ClassAspect), intent(in) :: this + type(MultiState), intent(inout) :: multi_state + type(ActualConnectionPt), intent(in) :: actual_pt + integer, optional, intent(out) :: rc + end subroutine I_add_to_state + + subroutine I_add_to_bundle(this, field_bundle, rc) + use ESMF, only: ESMF_FieldBundle + import ClassAspect + class(ClassAspect), intent(in) :: this + type(ESMF_FieldBundle), intent(inout) :: field_bundle + integer, optional, intent(out) :: rc + end subroutine I_add_to_bundle + + end interface +contains function to_class_from_poly(aspect, rc) result(class_aspect) class(ClassAspect), allocatable :: class_aspect @@ -60,4 +109,4 @@ function get_aspect_id() result(aspect_id) end function get_aspect_id -end module mapl3_ClassAspect +end module mapl3g_ClassAspect diff --git a/generic3g/specs/FieldSpec.F90 b/generic3g/specs/FieldSpec.F90 index ed0d51d72481..569cd3fb8bf5 100644 --- a/generic3g/specs/FieldSpec.F90 +++ b/generic3g/specs/FieldSpec.F90 @@ -267,9 +267,11 @@ subroutine allocate(this, rc) integer, allocatable :: num_levels_grid integer, allocatable :: num_levels - type(VerticalStaggerLoc) :: vert_staggerloc + type(VerticalStaggerLoc) :: vertical_staggerloc + class(VerticalGrid), allocatable :: vertical_grid + type(VerticalDimSpec) :: vertical_dim_spec class(StateItemAspect), pointer :: aspect - type(UngriddedDims), pointer :: ungridded_dims + type(UngriddedDims) :: ungridded_dims type(ESMF_TypeKind_Flag) :: typekind character(:), allocatable :: units @@ -281,7 +283,7 @@ subroutine allocate(this, rc) aspect => this%get_aspect('GEOM', _RC) select type (aspect) class is (GeomAspect) - call ESMF_FieldEmptySet(this%payload, aspect%geom, _RC) + call ESMF_FieldEmptySet(this%payload, aspect%get_geom(), _RC) class default _FAIL('no geom aspect') end select @@ -290,14 +292,17 @@ subroutine allocate(this, rc) select type (aspect) class is (VerticalGridAspect) - num_levels_grid = aspect%vertical_grid%get_num_levels() - if (aspect%vertical_dim_spec == VERTICAL_DIM_NONE) then - vert_staggerloc = VERTICAL_STAGGER_NONE - else if (aspect%vertical_dim_spec == VERTICAL_DIM_EDGE) then - vert_staggerloc = VERTICAL_STAGGER_EDGE + + vertical_grid = aspect%get_vertical_grid(_RC) + num_levels_grid = vertical_grid%get_num_levels() + vertical_dim_spec = aspect%get_vertical_dim_spec(_RC) + if (vertical_dim_spec == VERTICAL_DIM_NONE) then + vertical_staggerloc = VERTICAL_STAGGER_NONE + else if (vertical_dim_spec == VERTICAL_DIM_EDGE) then + vertical_staggerloc = VERTICAL_STAGGER_EDGE num_levels = num_levels_grid + 1 - else if (aspect%vertical_dim_spec == VERTICAL_DIM_CENTER) then - vert_staggerloc = VERTICAL_STAGGER_CENTER + else if (vertical_dim_spec == VERTICAL_DIM_CENTER) then + vertical_staggerloc = VERTICAL_STAGGER_CENTER num_levels = num_levels_grid else _FAIL('unknown stagger') @@ -307,22 +312,19 @@ subroutine allocate(this, rc) end select aspect => this%get_aspect('UNGRIDDED_DIMS', _RC) - ungridded_dims => null() if (associated(aspect)) then select type (aspect) class is (UngriddedDimsAspect) - if (allocated(aspect%ungridded_dims)) then - ungridded_dims => aspect%ungridded_dims - end if + ungridded_dims = aspect%get_ungridded_dims(_RC) class default - _FAIL('no ungrgeom aspect') + _FAIL('no ungridded_dims aspect') end select end if aspect => this%get_aspect('UNITS', _RC) select type(aspect) class is (UnitsAspect) - units = aspect%units + units = aspect%get_units(_RC) class default _FAIL('no units aspect') end select @@ -339,7 +341,7 @@ subroutine allocate(this, rc) typekind=typekind, & ungridded_dims=ungridded_dims, & num_levels=num_levels, & - vert_staggerLoc=vert_staggerLoc, & + vert_staggerLoc=vertical_staggerLoc, & units=units, & standard_name=this%standard_name, & long_name=this%long_name, & diff --git a/generic3g/specs/GeomAspect.F90 b/generic3g/specs/GeomAspect.F90 index cda2f81c1870..925b1b641bbc 100644 --- a/generic3g/specs/GeomAspect.F90 +++ b/generic3g/specs/GeomAspect.F90 @@ -23,6 +23,7 @@ module mapl3g_GeomAspect end interface to_GeomAspect type, extends(StateItemAspect) :: GeomAspect + private type(ESMF_Geom), allocatable :: geom type(EsmfRegridderParam) :: regridder_param type(HorizontalDimsSpec) :: horizontal_dims_spec = HORIZONTAL_DIMS_GEOM ! none, geom diff --git a/generic3g/specs/UngriddedDimsAspect.F90 b/generic3g/specs/UngriddedDimsAspect.F90 index e432909a23a3..6e01608b5611 100644 --- a/generic3g/specs/UngriddedDimsAspect.F90 +++ b/generic3g/specs/UngriddedDimsAspect.F90 @@ -19,7 +19,7 @@ module mapl3g_UngriddedDimsAspect end interface to_UngriddedDimsAspect type, extends(StateItemAspect) :: UngriddedDimsAspect -!# private + private type(UngriddedDims), allocatable :: ungridded_dims contains procedure :: matches @@ -29,6 +29,8 @@ module mapl3g_UngriddedDimsAspect procedure :: make_action procedure :: make_action2 procedure, nopass :: get_aspect_id + + procedure :: get_ungridded_dims end type UngriddedDimsAspect interface UngriddedDimsAspect @@ -43,6 +45,8 @@ function new_UngriddedDimsAspect(ungridded_dims) result(aspect) type(UngriddedDims), optional, intent(in) :: ungridded_dims call aspect%set_mirror(.true.) + aspect%ungridded_dims = UngriddedDims() + if (present(ungridded_dims)) then aspect%ungridded_dims = ungridded_dims call aspect%set_mirror(.false.) @@ -149,5 +153,17 @@ function get_aspect_id() result(aspect_id) aspect_id = UNGRIDDED_DIMS_ASPECT_ID end function get_aspect_id + function get_ungridded_dims(this, rc) result(ungridded_dims) + type(UngriddedDims) :: ungridded_dims + class(UngriddedDimsAspect), intent(in) :: this + integer, optional, intent(out) :: rc + + integer :: status + + _ASSERT(allocated(this%ungridded_dims), "ungridded_dims not allocated.") + ungridded_dims = this%ungridded_dims + + _RETURN(_SUCCESS) + end function get_ungridded_dims end module mapl3g_UngriddedDimsAspect diff --git a/generic3g/specs/UnitsAspect.F90 b/generic3g/specs/UnitsAspect.F90 index 661a5d6692b8..61c2325531dc 100644 --- a/generic3g/specs/UnitsAspect.F90 +++ b/generic3g/specs/UnitsAspect.F90 @@ -20,7 +20,7 @@ module mapl3g_UnitsAspect end interface to_UnitsAspect type, extends(StateItemAspect) :: UnitsAspect -!# private + private character(:), allocatable :: units contains procedure :: matches @@ -30,6 +30,8 @@ module mapl3g_UnitsAspect procedure :: supports_conversion_general procedure :: supports_conversion_specific procedure, nopass :: get_aspect_id + + procedure :: get_units end type UnitsAspect interface UnitsAspect @@ -178,4 +180,18 @@ function get_aspect_id() result(aspect_id) aspect_id = UNITS_ASPECT_ID end function get_aspect_id + function get_units(this, rc) result(units) + character(:), allocatable :: units + class(UnitsAspect), intent(in) :: this + integer, optional, intent(out) :: rc + + integer :: status + + units = '' + _ASSERT(allocated(this%units), 'UnitsAspect has no units') + units = this%units + + _RETURN(_SUCCESS) + end function get_units + end module mapl3g_UnitsAspect diff --git a/generic3g/specs/VerticalGridAspect.F90 b/generic3g/specs/VerticalGridAspect.F90 index 55b4037580c6..ac0c52786f5c 100644 --- a/generic3g/specs/VerticalGridAspect.F90 +++ b/generic3g/specs/VerticalGridAspect.F90 @@ -27,7 +27,7 @@ module mapl3g_VerticalGridAspect end interface to_VerticalGridAspect type, extends(StateItemAspect) :: VerticalGridAspect -!# private + private class(VerticalGrid), allocatable :: vertical_grid type(VerticalRegridMethod) :: regrid_method = VERTICAL_REGRID_LINEAR !# type(VerticalStaggerLoc), allocatable :: vertical_staggerloc @@ -49,6 +49,8 @@ module mapl3g_VerticalGridAspect procedure :: set_vertical_grid procedure :: set_geom procedure :: set_typekind + procedure :: get_vertical_grid + procedure :: get_vertical_dim_spec end type VerticalGridAspect interface VerticalGridAspect @@ -287,4 +289,30 @@ function get_aspect_id() result(aspect_id) aspect_id = VERTICAL_GRID_ASPECT_ID end function get_aspect_id + function get_vertical_grid(this, rc) result(vertical_grid) + class(VerticalGridAspect), intent(in) :: this + class(VerticalGrid), allocatable :: vertical_grid + integer, optional, intent(out) :: rc + + integer :: status + + _ASSERT(allocated(this%vertical_grid), "vertical_grid not allocated.") + vertical_grid = this%vertical_grid + + _RETURN(_SUCCESS) + end function get_vertical_grid + + function get_vertical_dim_spec(this, rc) result(vertical_dim_spec) + class(VerticalGridAspect), intent(in) :: this + type(VerticalDimSpec) :: vertical_dim_spec + integer, optional, intent(out) :: rc + + integer :: status + + _ASSERT(allocated(this%vertical_dim_spec), "vertical_dim_spec not allocated.") + vertical_dim_spec = this%vertical_dim_spec + + _RETURN(_SUCCESS) + end function get_vertical_dim_spec + end module mapl3g_VerticalGridAspect From 9c8ad803c5bc6c2ecfba1ef953351ee64b94d503 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Wed, 22 Jan 2025 16:46:58 -0500 Subject: [PATCH 09/15] Filling in the holes. All compiles - unit tests pass. --- generic3g/specs/AttributesAspect.F90 | 5 +- generic3g/specs/CMakeLists.txt | 1 + generic3g/specs/FieldClassAspect.F90 | 323 ++++++++++++++++++++++++ generic3g/specs/FrequencyAspect.F90 | 5 +- generic3g/specs/GeomAspect.F90 | 5 +- generic3g/specs/StateClassAspect.F90 | 34 +++ generic3g/specs/StateItemAspect.F90 | 4 +- generic3g/specs/StateItemSpec.F90 | 22 +- generic3g/specs/TypekindAspect.F90 | 5 +- generic3g/specs/UngriddedDimsAspect.F90 | 5 +- generic3g/specs/UnitsAspect.F90 | 5 +- generic3g/specs/VerticalGridAspect.F90 | 5 +- generic3g/specs/WildcardClassAspect.F90 | 244 ++++++++++++++++++ generic3g/specs/WildcardSpec.F90 | 6 +- generic3g/tests/MockAspect.F90 | 5 +- 15 files changed, 659 insertions(+), 15 deletions(-) create mode 100644 generic3g/specs/FieldClassAspect.F90 create mode 100644 generic3g/specs/StateClassAspect.F90 create mode 100644 generic3g/specs/WildcardClassAspect.F90 diff --git a/generic3g/specs/AttributesAspect.F90 b/generic3g/specs/AttributesAspect.F90 index 65828d353a3b..56b378b1d5d3 100644 --- a/generic3g/specs/AttributesAspect.F90 +++ b/generic3g/specs/AttributesAspect.F90 @@ -5,6 +5,7 @@ ! be unused and/or correspond to attributes needed by other imports. module mapl3g_AttributesAspect + use mapl3g_ActualConnectionPt use mapl3g_AspectId use mapl3g_StateItemAspect use mapl3g_ExtensionAction @@ -124,14 +125,16 @@ function get_aspect_id() result(aspect_id) end function get_aspect_id ! No-op (cannot mirror) - subroutine connect_to_export(this, export, rc) + subroutine connect_to_export(this, export, actual_pt, rc) class(AttributesAspect), intent(inout) :: this class(StateItemAspect), intent(in) :: export + type(ActualConnectionPt), intent(in) :: actual_pt integer, optional, intent(out) :: rc _RETURN(_SUCCESS) _UNUSED_DUMMY(this) _UNUSED_DUMMY(export) + _UNUSED_DUMMY(actual_pt) end subroutine connect_to_export end module mapl3g_AttributesAspect diff --git a/generic3g/specs/CMakeLists.txt b/generic3g/specs/CMakeLists.txt index 6ee60dd08930..40026eddf1ef 100644 --- a/generic3g/specs/CMakeLists.txt +++ b/generic3g/specs/CMakeLists.txt @@ -3,6 +3,7 @@ target_sources(MAPL.generic3g PRIVATE StateItemAspect.F90 ClassAspect.F90 FieldClassAspect.F90 + WildcardClassAspect.F90 AspectCollection.F90 AttributesAspect.F90 diff --git a/generic3g/specs/FieldClassAspect.F90 b/generic3g/specs/FieldClassAspect.F90 new file mode 100644 index 000000000000..8f17fb5a94ab --- /dev/null +++ b/generic3g/specs/FieldClassAspect.F90 @@ -0,0 +1,323 @@ +#include "MAPL_Generic.h" + +module mapl3g_FieldClassAspect + use mapl3g_ActualConnectionPt + + use mapl3g_AspectId + use mapl3g_StateItemAspect + use mapl3g_ClassAspect + use mapl3g_GeomAspect + use mapl3g_VerticalGridAspect + use mapl3g_UnitsAspect + use mapl3g_TypekindAspect + use mapl3g_UngriddedDimsAspect + + use mapl3g_VerticalGrid + use mapl3g_VerticalDimSpec + use mapl3g_VerticalStaggerLoc + use mapl3g_UngriddedDims + + use mapl3g_NullAction + use mapl3g_ExtensionAction + use mapl3g_MultiState + use mapl3g_ESMF_Utilities, only: get_substate + + use mapl3g_FieldCreate + use mapl_FieldUtilities + + use mapl_ErrorHandling + use esmf + implicit none(type,external) + private + + public :: FieldClassAspect + public :: to_FieldClassAspect + + interface to_FieldClassAspect + procedure :: to_fieldclassaspect_from_poly + procedure :: to_fieldclassaspect_from_map + end interface to_FieldClassAspect + + type, extends(ClassAspect) :: FieldClassAspect + private + type(ESMF_Field) :: payload + character(:), allocatable :: standard_name + character(:), allocatable :: long_name + real(kind=ESMF_KIND_R4), allocatable :: default_value + contains + procedure :: make_action + procedure :: make_action2 + procedure :: matches + procedure :: supports_conversion_general + procedure :: supports_conversion_specific + procedure :: connect_to_export + + procedure :: create + procedure :: allocate + procedure :: destroy + procedure :: add_to_state + procedure :: add_to_bundle + + end type FieldClassAspect + + interface FieldClassAspect + procedure :: new_FieldClassAspect + end interface FieldClassAspect + +contains + + function new_FieldClassAspect(standard_name, long_name, default_value) result(aspect) + type(FieldClassAspect) :: aspect + character(*), intent(in) :: standard_name + character(*), intent(in) :: long_name + real(kind=ESMF_KIND_R4), intent(in), optional :: default_value + + aspect%standard_name = standard_name + aspect%long_name = long_name + if (present(default_value)) then + aspect%default_value = default_value + end if + + end function new_FieldClassAspect + + subroutine create(this, rc) + class(FieldClassAspect), intent(inout) :: this + integer, optional, intent(out) :: rc + + integer :: status + + this%payload = ESMF_FieldEmptyCreate(_RC) + + _RETURN(ESMF_SUCCESS) + end subroutine create + + ! Tile / Grid X or X, Y + subroutine allocate(this, other_aspects, rc) + class(FieldClassAspect), intent(inout) :: this + type(AspectMap), intent(in) :: other_aspects + integer, optional, intent(out) :: rc + + integer :: status + type(ESMF_FieldStatus_Flag) :: fstatus + + + type(GeomAspect) :: geom_aspect + type(ESMF_Geom) :: geom + + type(VerticalGridAspect) :: vert_aspect + class(VerticalGrid), allocatable :: vert_grid + type(VerticalDimSpec) :: vertical_dim_spec + type(VerticalStaggerLoc) :: vert_staggerloc + integer, allocatable :: num_levels_grid + integer, allocatable :: num_levels + + type(UngriddedDimsAspect) :: ungridded_dims_aspect + type(UngriddedDims) :: ungridded_dims + + type(UnitsAspect) :: units_aspect + character(:), allocatable :: units + + type(TypekindAspect) :: typekind_aspect + type(ESMF_TypeKind_Flag) :: typekind + + call ESMF_FieldGet(this%payload, status=fstatus, _RC) + _RETURN_IF(fstatus == ESMF_FIELDSTATUS_COMPLETE) + + geom_aspect = to_GeomAspect(other_aspects, _RC) + geom = geom_aspect%get_geom(_RC) + call ESMF_FieldEmptySet(this%payload, geom, _RC) + + vert_aspect = to_VerticalGridAspect(other_aspects, _RC) + vert_grid = vert_aspect%get_vertical_grid(_RC) + num_levels_grid = vert_grid%get_num_levels() + vertical_dim_spec = vert_aspect%get_vertical_dim_spec() + if (vertical_dim_spec == VERTICAL_DIM_NONE) then + vert_staggerloc = VERTICAL_STAGGER_NONE + else if (vertical_dim_spec == VERTICAL_DIM_EDGE) then + vert_staggerloc = VERTICAL_STAGGER_EDGE + num_levels = num_levels_grid + 1 + else if (vertical_dim_spec == VERTICAL_DIM_CENTER) then + vert_staggerloc = VERTICAL_STAGGER_CENTER + num_levels = num_levels_grid + else + _FAIL('unknown stagger') + end if + + ungridded_dims_aspect = to_UngriddedDimsAspect(other_aspects, _RC) + ungridded_dims = ungridded_dims_aspect%get_ungridded_dims() + + units_aspect = to_UnitsAspect(other_aspects, _RC) + units = units_aspect%get_units(_RC) + + typekind_aspect = to_TypekindAspect(other_aspects, _RC) + typekind = typekind_aspect%get_typekind() + + call MAPL_FieldEmptyComplete(this%payload, & + typekind=typekind, & + ungridded_dims=ungridded_dims, & + num_levels=num_levels, & + vert_staggerLoc=vert_staggerLoc, & + units=units, & + standard_name=this%standard_name, & + long_name=this%long_name, & + _RC) + _VERIFY(status) + + call ESMF_FieldGet(this%payload, status=fstatus, _RC) + _ASSERT(fstatus == ESMF_FIELDSTATUS_COMPLETE, 'ESMF field status problem.') + + if (allocated(this%default_value)) then + call FieldSet(this%payload, this%default_value, _RC) + end if + + _RETURN(ESMF_SUCCESS) + end subroutine allocate + + + subroutine destroy(this, rc) + class(FieldClassAspect), intent(inout) :: this + integer, optional, intent(out) :: rc + + integer :: status + + call ESMF_FieldDestroy(this%payload, nogarbage=.true., _RC) + + _RETURN(ESMF_SUCCESS) + end subroutine destroy + + + subroutine connect_to_export(this, export, actual_pt, rc) + class(FieldClassAspect), intent(inout) :: this + class(StateItemAspect), intent(in) :: export + type(ActualConnectionPt), intent(in) :: actual_pt + integer, optional, intent(out) :: rc + + type(FieldClassAspect) :: export_ + integer :: status + + export_ = to_FieldClassAspect(export, _RC) + this%payload = export_%payload + + _RETURN(_SUCCESS) + _UNUSED_DUMMY(actual_pt) + end subroutine connect_to_export + + + function to_fieldclassaspect_from_poly(aspect, rc) result(field_aspect) + type(FieldClassAspect) :: field_aspect + class(StateItemAspect), intent(in) :: aspect + integer, optional, intent(out) :: rc + + integer :: status + + select type(aspect) + class is (FieldClassAspect) + field_aspect = aspect + class default + _FAIL('aspect is not FieldClassAspect') + end select + + _RETURN(_SUCCESS) + end function to_fieldclassaspect_from_poly + + function to_fieldclassaspect_from_map(map, rc) result(field_aspect) + type(FieldClassAspect) :: field_aspect + type(AspectMap), target, intent(in) :: map + integer, optional, intent(out) :: rc + + integer :: status + class(StateItemAspect), pointer :: poly + + poly => map%at(CLASS_ASPECT_ID, _RC) + field_aspect = to_FieldClassAspect(poly, _RC) + + _RETURN(_SUCCESS) + end function to_fieldclassaspect_from_map + + + function make_action(src, dst, rc) result(action) + class(ExtensionAction), allocatable :: action + class(FieldClassAspect), intent(in) :: src + class(StateItemAspect), intent(in) :: dst + integer, optional, intent(out) :: rc + + action = NullAction() + _RETURN(_SUCCESS) + end function make_action + + function make_action2(src, dst, other_aspects, rc) result(action) + class(ExtensionAction), allocatable :: action + class(FieldClassAspect), intent(in) :: src + class(StateItemAspect), intent(in) :: dst + type(AspectMap), target, intent(in) :: other_aspects + integer, optional, intent(out) :: rc + + action = NullAction() + + _RETURN(_SUCCESS) + end function make_action2 + + logical function matches(src, dst) + class(FieldClassAspect), intent(in) :: src + class(StateItemAspect), intent(in) :: dst + + matches = .false. + select type(dst) + class is (FieldClassAspect) + matches = .true. + end select + + end function matches + + logical function supports_conversion_general(src) + class(FieldClassAspect), intent(in) :: src + supports_conversion_general = .false. + end function supports_conversion_general + + logical function supports_conversion_specific(src, dst) + class(FieldClassAspect), intent(in) :: src + class(StateItemAspect), intent(in) :: dst + + supports_conversion_specific = .false. + + _UNUSED_DUMMY(dst) + end function supports_conversion_specific + + subroutine add_to_state(this, multi_state, actual_pt, rc) + class(FieldClassAspect), intent(in) :: this + type(MultiState), intent(inout) :: multi_state + type(ActualConnectionPt), intent(in) :: actual_pt + integer, optional, intent(out) :: rc + + type(ESMF_Field) :: alias + integer :: status + type(ESMF_State) :: state, substate + character(:), allocatable :: full_name, inner_name + integer :: idx + + call multi_state%get_state(state, actual_pt%get_state_intent(), _RC) + + full_name = actual_pt%get_full_name() + idx = index(full_name, '/', back=.true.) + call get_substate(state, full_name(:idx-1), substate=substate, _RC) + inner_name = full_name(idx+1:) + + alias = ESMF_NamedAlias(this%payload, name=inner_name, _RC) + call ESMF_StateAdd(substate, [alias], _RC) + + _RETURN(_SUCCESS) + end subroutine add_to_state + + subroutine add_to_bundle(this, field_bundle, rc) + class(FieldClassAspect), intent(in) :: this + type(ESMF_FieldBundle), intent(inout) :: field_bundle + integer, optional, intent(out) :: rc + + integer :: status + + call ESMF_FieldBundleAdd(field_bundle, [this%payload], multiflag=.true., _RC) + + _RETURN(_SUCCESS) + end subroutine add_to_bundle + +end module mapl3g_FieldClassAspect diff --git a/generic3g/specs/FrequencyAspect.F90 b/generic3g/specs/FrequencyAspect.F90 index a31b97fe0368..192ae55bcc7e 100644 --- a/generic3g/specs/FrequencyAspect.F90 +++ b/generic3g/specs/FrequencyAspect.F90 @@ -1,6 +1,7 @@ #include "MAPL_Generic.h" #include "unused_dummy.H" module mapl3g_FrequencyAspect + use mapl3g_ActualConnectionPt use mapl3g_AspectId use mapl3g_StateItemAspect use mapl3g_AccumulatorActionInterface @@ -164,14 +165,16 @@ function make_action2(src, dst, other_aspects, rc) result(action) _RETURN(_SUCCESS) end function make_action2 - subroutine connect_to_export(this, export, rc) + subroutine connect_to_export(this, export, actual_pt, rc) class(FrequencyAspect), intent(inout) :: this class(StateItemAspect), intent(in) :: export + type(ActualConnectionPt), intent(in) :: actual_pt integer, optional, intent(out) :: rc _RETURN(_SUCCESS) _UNUSED_DUMMY(this) _UNUSED_DUMMY(export) + _UNUSED_DUMMY(actual_pt) end subroutine connect_to_export logical function supports_conversion_general(src) result(supports) diff --git a/generic3g/specs/GeomAspect.F90 b/generic3g/specs/GeomAspect.F90 index 925b1b641bbc..26feb87842c1 100644 --- a/generic3g/specs/GeomAspect.F90 +++ b/generic3g/specs/GeomAspect.F90 @@ -1,6 +1,7 @@ #include "MAPL_Generic.h" module mapl3g_GeomAspect + use mapl3g_ActualConnectionPt use mapl3g_AspectId use mapl3g_HorizontalDimsSpec use mapl3g_StateItemAspect @@ -162,9 +163,10 @@ function get_geom(this, rc) result(geom) _RETURN(_SUCCESS) end function get_geom - subroutine connect_to_export(this, export, rc) + subroutine connect_to_export(this, export, actual_pt, rc) class(GeomAspect), intent(inout) :: this class(StateItemAspect), intent(in) :: export + type(ActualConnectionPt), intent(in) :: actual_pt integer, optional, intent(out) :: rc type(GeomAspect) :: export_ @@ -174,6 +176,7 @@ subroutine connect_to_export(this, export, rc) this%geom = export_%geom _RETURN(_SUCCESS) + _UNUSED_DUMMY(actual_pt) end subroutine connect_to_export function to_geom_from_poly(aspect, rc) result(geom_aspect) diff --git a/generic3g/specs/StateClassAspect.F90 b/generic3g/specs/StateClassAspect.F90 new file mode 100644 index 000000000000..4950b1007d7a --- /dev/null +++ b/generic3g/specs/StateClassAspect.F90 @@ -0,0 +1,34 @@ + type :: StateClassAspect + type(StateRegistry) :: registry + type(ActualPtStateItemSpecMap) :: items + end type StateClassAspect + + logical function matches(src, dst) + + ! every item in dst matches src + ! extra items in src is not a problem + + end function matches + + function make_action2(src, dst, other_aspects, rc) result(action) + class(ExtensionAction), allocatable :: action + class(StateClassAspect), intent(in) :: src + class(StateItemAspect), intent(in) :: dst + type(AspectMap), target, intent(in) :: other_aspects + integer, optional, intent(out) :: rc + + + ! dst must also be State + + action = StateAction(src, dst) + + _RETURN(_SUCCESS) + end function make_action2 + + + type :: StateAction + contains + procedure :: update + end type StateAction + + diff --git a/generic3g/specs/StateItemAspect.F90 b/generic3g/specs/StateItemAspect.F90 index 836c64832cd1..f590141195b7 100644 --- a/generic3g/specs/StateItemAspect.F90 +++ b/generic3g/specs/StateItemAspect.F90 @@ -128,10 +128,12 @@ function I_make_action2(src, dst, other_aspects, rc) result(action) integer, optional, intent(out) :: rc end function I_make_action2 - subroutine I_connect_to_export(this, export, rc) + subroutine I_connect_to_export(this, export, actual_pt, rc) + use mapl3g_ActualConnectionPt import :: StateItemAspect class(StateItemAspect), intent(inout) :: this class(StateItemAspect), intent(in) :: export + type(ActualConnectionPt), intent(in) :: actual_pt integer, optional, intent(out) :: rc end subroutine I_connect_to_export diff --git a/generic3g/specs/StateItemSpec.F90 b/generic3g/specs/StateItemSpec.F90 index 642442375058..14f93c528b91 100644 --- a/generic3g/specs/StateItemSpec.F90 +++ b/generic3g/specs/StateItemSpec.F90 @@ -1,6 +1,7 @@ #include "MAPL_Generic.h" module mapl3g_StateItemSpec + use mapl3g_AspectId use mapl3g_ActualPtVector use mapl3g_ExtensionAction use mapl3g_StateItemAspect @@ -72,7 +73,9 @@ module mapl3g_StateItemSpec !# procedure, non_overridable :: get_aspect !# procedure, non_overridable :: get_aspects !# procedure, non_overridable :: set_aspect - procedure :: get_aspect + procedure :: get_aspect_by_name + procedure :: get_aspect_by_id + generic :: get_aspect => get_aspect_by_name, get_aspect_by_id procedure :: get_aspects procedure :: set_aspect @@ -267,7 +270,7 @@ subroutine set_raw_dependencies(this, raw_dependencies) this%raw_dependencies = raw_dependencies end subroutine set_raw_dependencies - function get_aspect(this, name, rc) result(aspect) + function get_aspect_by_name(this, name, rc) result(aspect) class(StateItemAspect), pointer :: aspect character(*), intent(in) :: name class(StateItemSpec), target, intent(in) :: this @@ -278,7 +281,20 @@ function get_aspect(this, name, rc) result(aspect) aspect => this%aspects%get_aspect(name, _RC) _RETURN(_SUCCESS) - end function get_aspect + end function get_aspect_by_name + + function get_aspect_by_id(this, aspect_id, rc) result(aspect) + class(StateItemAspect), pointer :: aspect + type(AspectId), intent(in) :: aspect_id + class(StateItemSpec), target, intent(in) :: this + integer, optional, intent(out) :: rc + + integer :: status + + _FAIL('not implemented yet') + + _RETURN(_SUCCESS) + end function get_aspect_by_id function get_aspects(this) result(aspects) type(AspectCollection), pointer :: aspects diff --git a/generic3g/specs/TypekindAspect.F90 b/generic3g/specs/TypekindAspect.F90 index c52b1f9ba0c4..5441f806da52 100644 --- a/generic3g/specs/TypekindAspect.F90 +++ b/generic3g/specs/TypekindAspect.F90 @@ -1,6 +1,7 @@ #include "MAPL_Generic.h" module mapl3g_TypekindAspect + use mapl3g_ActualConnectionPt use mapl3g_AspectId use mapl3g_StateItemAspect use mapl3g_ExtensionAction @@ -116,9 +117,10 @@ end function make_action2 ! Copy from src - might have been mirror. - subroutine connect_to_export(this, export, rc) + subroutine connect_to_export(this, export, actual_pt, rc) class(TypekindAspect), intent(inout) :: this class(StateItemAspect), intent(in) :: export + type(ActualConnectionPt), intent(in) :: actual_pt integer, optional, intent(out) :: rc type(TypekindAspect) :: export_ @@ -127,6 +129,7 @@ subroutine connect_to_export(this, export, rc) export_ = to_TypekindAspect(export, _RC) this%typekind = export_%typekind _RETURN(_SUCCESS) + _UNUSED_DUMMY(actual_pt) end subroutine connect_to_export subroutine set_typekind(this, typekind) diff --git a/generic3g/specs/UngriddedDimsAspect.F90 b/generic3g/specs/UngriddedDimsAspect.F90 index 6e01608b5611..086de508a748 100644 --- a/generic3g/specs/UngriddedDimsAspect.F90 +++ b/generic3g/specs/UngriddedDimsAspect.F90 @@ -1,6 +1,7 @@ #include "MAPL_Generic.h" module mapl3g_UngriddedDimsAspect + use mapl3g_ActualConnectionPt use mapl3g_AspectId use mapl3g_StateItemAspect use mapl3g_ExtensionAction @@ -134,9 +135,10 @@ function make_action2(src, dst, other_aspects, rc) result(action) _RETURN(_SUCCESS) end function make_action2 - subroutine connect_to_export(this, export, rc) + subroutine connect_to_export(this, export, actual_pt, rc) class(UngriddedDimsAspect), intent(inout) :: this class(StateItemAspect), intent(in) :: export + type(ActualConnectionPt), intent(in) :: actual_pt integer, optional, intent(out) :: rc type(UngriddedDimsAspect) :: export_ @@ -146,6 +148,7 @@ subroutine connect_to_export(this, export, rc) this%ungridded_dims = export_%ungridded_dims _RETURN(_SUCCESS) + _UNUSED_DUMMY(actual_pt) end subroutine connect_to_export function get_aspect_id() result(aspect_id) diff --git a/generic3g/specs/UnitsAspect.F90 b/generic3g/specs/UnitsAspect.F90 index 61c2325531dc..d9159256a60d 100644 --- a/generic3g/specs/UnitsAspect.F90 +++ b/generic3g/specs/UnitsAspect.F90 @@ -1,6 +1,7 @@ #include "MAPL_Generic.h" module mapl3g_UnitsAspect + use mapl3g_ActualConnectionPt use mapl3g_AspectId use mapl3g_StateItemAspect use mapl3g_ExtensionAction @@ -130,9 +131,10 @@ function make_action2(src, dst, other_aspects, rc) result(action) _RETURN(_SUCCESS) end function make_action2 - subroutine connect_to_export(this, export, rc) + subroutine connect_to_export(this, export, actual_pt, rc) class(UnitsAspect), intent(inout) :: this class(StateItemAspect), intent(in) :: export + type(ActualConnectionPt), intent(in) :: actual_pt integer, optional, intent(out) :: rc type(UnitsAspect) :: export_ @@ -142,6 +144,7 @@ subroutine connect_to_export(this, export, rc) this%units = export_%units _RETURN(_SUCCESS) + _UNUSED_DUMMY(actual_pt) end subroutine connect_to_export function to_units_from_poly(aspect, rc) result(units_aspect) diff --git a/generic3g/specs/VerticalGridAspect.F90 b/generic3g/specs/VerticalGridAspect.F90 index ac0c52786f5c..3dd455823f90 100644 --- a/generic3g/specs/VerticalGridAspect.F90 +++ b/generic3g/specs/VerticalGridAspect.F90 @@ -1,6 +1,7 @@ #include "MAPL_Generic.h" module mapl3g_VerticalGridAspect + use mapl3g_ActualConnectionPt use mapl3g_AspectId use mapl3g_StateItemAspect use mapl3g_ExtensionAction @@ -239,9 +240,10 @@ subroutine set_typekind(self, typekind) self%typekind = typekind end subroutine set_typekind - subroutine connect_to_export(this, export, rc) + subroutine connect_to_export(this, export, actual_pt, rc) class(VerticalGridAspect), intent(inout) :: this class(StateItemAspect), intent(in) :: export + type(ActualConnectionPt), intent(in) :: actual_pt integer, optional, intent(out) :: rc type(VerticalGridAspect) :: export_ @@ -251,6 +253,7 @@ subroutine connect_to_export(this, export, rc) this%vertical_grid = export_%vertical_grid _RETURN(_SUCCESS) + _UNUSED_DUMMY(actual_pt) end subroutine connect_to_export function to_vertical_grid_from_poly(aspect, rc) result(vertical_grid_aspect) diff --git a/generic3g/specs/WildcardClassAspect.F90 b/generic3g/specs/WildcardClassAspect.F90 new file mode 100644 index 000000000000..ca927bad3bf6 --- /dev/null +++ b/generic3g/specs/WildcardClassAspect.F90 @@ -0,0 +1,244 @@ +#include "MAPL_Generic.h" + +module mapl3g_WildcardClassAspect + use mapl3g_ActualPtStateItemSpecMap + use mapl3g_ActualConnectionPt + use mapl3g_StateItemSpec + use mapl3g_AspectId + use mapl3g_StateItemAspect + use mapl3g_ClassAspect + use mapl3g_FieldClassAspect + use mapl3g_ExtensionAction + use mapl3g_NullAction + use mapl3g_MultiState + use mapl_ErrorHandling + use esmf + implicit none(type,external) + private + + public :: WildcardClassAspect + + type, extends(ClassAspect) :: WildcardClassAspect + private + class(StateItemSpec), allocatable :: reference_spec + type(ActualPtStateItemSpecMap) :: matched_items + contains + + procedure :: supports_conversion_general + procedure :: supports_conversion_specific + procedure :: matches + procedure :: make_action + procedure :: make_action2 + procedure :: connect_to_export + + procedure :: create + procedure :: allocate + procedure :: destroy + procedure :: add_to_state + procedure :: add_to_bundle + + end type WildcardClassAspect + + interface WildcardClassAspect + procedure :: new_WildcardClassAspect + end interface WildcardClassAspect + +contains + + function new_WildcardClassAspect(reference_spec) result(wildcard_aspect) + type(WildcardClassAspect) :: wildcard_aspect + class(StateItemSpec), intent(in) :: reference_spec + + wildcard_aspect%reference_spec = reference_spec + + end function new_WildcardClassAspect + + + ! Wildcard not permitted as an export. + logical function matches(src, dst) + class(WildcardClassAspect), intent(in) :: src + class(StateItemAspect), intent(in) :: dst + + matches = .false. + + end function matches + + ! Wildcard not permitted as an export. + function make_action(src, dst, rc) result(action) + class(ExtensionAction), allocatable :: action + class(WildcardClassAspect), intent(in) :: src + class(StateItemAspect), intent(in) :: dst + integer, optional, intent(out) :: rc + + action = NullAction() + _RETURN(_SUCCESS) + end function make_action + + ! Wildcard not permitted as an export. + function make_action2(src, dst, other_aspects, rc) result(action) + class(ExtensionAction), allocatable :: action + class(WildcardClassAspect), intent(in) :: src + class(StateItemAspect), intent(in) :: dst + type(AspectMap), target, intent(in) :: other_aspects + integer, optional, intent(out) :: rc + + action = NullAction() + + _RETURN(_SUCCESS) + end function make_action2 + + + subroutine connect_to_export(this, export, actual_pt, rc) + class(WildcardClassAspect), intent(inout) :: this + class(StateItemAspect), intent(in) :: export + type(ActualConnectionPt), intent(in) :: actual_pt + integer, optional, intent(out) :: rc + + type(FieldClassAspect) :: export_ + integer :: status + + ! Export must be a field - all other cases should fail + export_ = to_FieldClassAspect(export, _RC) + call typesafe_connect_to_export(this, export_, actual_pt, _RC) + + _RETURN(_SUCCESS) + end subroutine connect_to_export + + subroutine typesafe_connect_to_export(this, export, actual_pt, rc) + class(WildcardClassAspect), target, intent(inout) :: this + class(FieldClassAspect), intent(in) :: export + type(ActualConnectionPt), intent(in) :: actual_pt + integer, optional, intent(out) :: rc + + class(StateItemSpec), pointer :: spec + class(StateItemAspect), pointer :: import_class_aspect + integer :: status + + + call this%matched_items%insert(actual_pt, this%reference_spec) + spec => this%matched_items%of(actual_pt) + import_class_aspect => spec%get_aspect(CLASS_ASPECT_ID) + + select type (import_class_aspect) + type is (FieldClassAspect) + call import_class_aspect%connect_to_export(export, actual_pt, _RC) + class default + _FAIL("Export ClassAspect must be 'Field' to connect with Wildcard") + end select + + _RETURN(_SUCCESS) + end subroutine typesafe_connect_to_export + + ! No-op + subroutine create(this, rc) + class(WildcardClassAspect), intent(inout) :: this + integer, optional, intent(out) :: rc + + _RETURN(_SUCCESS) + _UNUSED_DUMMY(this) + end subroutine create + + ! No-op + subroutine destroy(this, rc) + class(WildcardClassAspect), intent(inout) :: this + integer, optional, intent(out) :: rc + + _RETURN(_SUCCESS) + _UNUSED_DUMMY(this) + end subroutine destroy + + ! No-op + ! Wildcard is always an import, and allocation is on exports. + subroutine allocate(this, other_aspects, rc) + class(WildcardClassAspect), intent(inout) :: this + type(AspectMap), intent(in) :: other_aspects + integer, optional, intent(out) :: rc + + _RETURN(_SUCCESS) + _UNUSED_DUMMY(this) + end subroutine allocate + + subroutine add_to_state(this, multi_state, actual_pt, rc) + class(WildcardClassAspect), intent(in) :: this + type(MultiState), intent(inout) :: multi_state + type(ActualConnectionPt), intent(in) :: actual_pt + integer, optional, intent(out) :: rc + + integer :: status + + call with_target_attribute(this, multi_state, actual_pt, _RC) + + _RETURN(_SUCCESS) + + contains + + subroutine with_target_attribute(this, multi_state, actual_pt, rc) + class(WildcardClassAspect), target, intent(in) :: this + type(MultiState), intent(inout) :: multi_state + type(ActualConnectionPt), intent(in) :: actual_pt + integer, optional, intent(out) :: rc + + integer :: status + type(ActualPtStateItemSpecMapIterator) :: iter + class(StateItemSpec), pointer :: spec_ptr + type(ActualConnectionPt), pointer :: effective_pt + type(ActualConnectionPt) :: use_pt + character(:), allocatable :: comp_name + integer :: label + + associate (e => this%matched_items%ftn_end()) + iter = this%matched_items%ftn_begin() + do while (iter /= e) + iter = next(iter) + ! Ignore actual_pt argument and use internally recorded name + effective_pt => iter%first() + comp_name = actual_pt%get_comp_name() + label = actual_pt%get_label() + use_pt = effective_pt + + if (label /= -1) then ! not primary + use_pt = use_pt%extend() + end if + + if (comp_name /= '') then + use_pt = use_pt%add_comp_name(comp_name) + end if + spec_ptr => iter%second() + call spec_ptr%add_to_state(multi_state, use_pt, _RC) + end do + end associate + + _RETURN(_SUCCESS) + end subroutine with_target_attribute + + end subroutine add_to_state + + subroutine add_to_bundle(this, field_bundle, rc) + class(WildcardClassAspect), intent(in) :: this + type(ESMF_FieldBundle), intent(inout) :: field_bundle + integer, optional, intent(out) :: rc + + integer :: status + + _FAIL('Wildcard cannot be added to a bundle.') + + _RETURN(_SUCCESS) + end subroutine add_to_bundle + + ! Wildcard is never an export + logical function supports_conversion_general(src) + class(WildcardClassAspect), intent(in) :: src + supports_conversion_general = .false. + end function supports_conversion_general + + logical function supports_conversion_specific(src, dst) + class(WildcardClassAspect), intent(in) :: src + class(StateItemAspect), intent(in) :: dst + + supports_conversion_specific = .false. + + _UNUSED_DUMMY(dst) + end function supports_conversion_specific + + +end module mapl3g_WildcardClassAspect diff --git a/generic3g/specs/WildcardSpec.F90 b/generic3g/specs/WildcardSpec.F90 index aa1a27975aea..c4ddf713214e 100644 --- a/generic3g/specs/WildcardSpec.F90 +++ b/generic3g/specs/WildcardSpec.F90 @@ -42,7 +42,7 @@ module mapl3g_WildcardSpec procedure :: get_reference_spec ! These might be unnecessary once aspects are fully integrated - procedure :: get_aspect + procedure :: get_aspect_by_name procedure :: get_aspects procedure :: set_aspect end type WildcardSpec @@ -234,7 +234,7 @@ function get_reference_spec(this) result(reference_spec) reference_spec => this%reference_spec end function get_reference_spec - function get_aspect(this, name, rc) result(aspect) + function get_aspect_by_name(this, name, rc) result(aspect) class(StateItemAspect), pointer :: aspect character(*), intent(in) :: name class(WildcardSpec), target, intent(in) :: this @@ -245,7 +245,7 @@ function get_aspect(this, name, rc) result(aspect) aspect => this%reference_spec%get_aspect(name, _RC) _RETURN(_SUCCESS) - end function get_aspect + end function get_aspect_by_name function get_aspects(this) result(aspects) type(AspectCollection), pointer :: aspects diff --git a/generic3g/tests/MockAspect.F90 b/generic3g/tests/MockAspect.F90 index a2a374a8739e..e7bd4012a5c6 100644 --- a/generic3g/tests/MockAspect.F90 +++ b/generic3g/tests/MockAspect.F90 @@ -1,6 +1,7 @@ #include "MAPL_Generic.h" module MockAspect_mod + use mapl3g_ActualConnectionPt use mapl3g_AspectId use mapl3g_StateItemASpect use mapl3g_ExtensionAction @@ -90,9 +91,10 @@ function make_action2(src, dst, other_aspects, rc) result(action) end function make_action2 - subroutine connect_to_export(this, export, rc) + subroutine connect_to_export(this, export, actual_pt, rc) class(MockAspect), intent(inout) :: this class(StateItemAspect), intent(in) :: export + type(ActualConnectionPt), intent(in) :: actual_pt integer, optional, intent(out) :: rc integer :: status @@ -108,6 +110,7 @@ subroutine connect_to_export(this, export, rc) end select _RETURN(_SUCCESS) + _UNUSED_DUMMY(actual_pt) end subroutine connect_to_export function get_aspect_id() result(aspect_id) From 5f1232cbd6e20c39439618337bf05f45d0f2bf7f Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Thu, 23 Jan 2025 09:01:39 -0500 Subject: [PATCH 10/15] Implemented ServiceClassAspect. Untested. --- generic3g/specs/CMakeLists.txt | 1 + generic3g/specs/make_itemSpec.F90 | 16 ++++++++++++++++ 2 files changed, 17 insertions(+) diff --git a/generic3g/specs/CMakeLists.txt b/generic3g/specs/CMakeLists.txt index 40026eddf1ef..4ccdda6d6e9e 100644 --- a/generic3g/specs/CMakeLists.txt +++ b/generic3g/specs/CMakeLists.txt @@ -4,6 +4,7 @@ target_sources(MAPL.generic3g PRIVATE ClassAspect.F90 FieldClassAspect.F90 WildcardClassAspect.F90 + ServiceClassAspect.F90 AspectCollection.F90 AttributesAspect.F90 diff --git a/generic3g/specs/make_itemSpec.F90 b/generic3g/specs/make_itemSpec.F90 index ab3724890f45..1e2805260b56 100644 --- a/generic3g/specs/make_itemSpec.F90 +++ b/generic3g/specs/make_itemSpec.F90 @@ -21,6 +21,8 @@ module mapl3g_make_itemSpec function make_itemSpec(variable_spec, registry, rc) result(item_spec) use mapl3g_VariableSpec, only: VariableSpec use mapl3g_ActualPtVector, only: ActualPtVector + use mapl3g_VirtualConnectionPt + use mapl3g_StateItemExtension class(StateItemSpec), allocatable :: item_spec class(VariableSpec), intent(in) :: variable_spec type(StateRegistry), pointer, intent(in) :: registry @@ -29,13 +31,27 @@ function make_itemSpec(variable_spec, registry, rc) result(item_spec) integer :: status type(FieldSpec) :: field_spec type(ActualPtVector) :: dependencies + integer :: i, n + type(StateItemSpecPtr), allocatable :: spec_ptrs(:) + type(VirtualConnectionPt) :: v_pt + type(StateItemExtension), pointer :: primary select case (variable_spec%itemtype%ot) case (MAPL_STATEITEM_FIELD%ot) allocate(FieldSpec :: item_spec) item_spec = FieldSpec(variable_spec) case (MAPL_STATEITEM_SERVICE%ot) + associate (items => variable_spec%service_items) + n = items%size() + allocate(spec_ptrs(n)) + do i = 1, n + v_pt = VirtualConnectionPt(ESMF_STATEINTENT_INTERNAL, items%of(i)) + primary => registry%get_primary_extension(v_pt, _RC) + spec_ptrs(i)%ptr => primary%get_spec() + end do + end associate allocate(ServiceSpec :: item_spec) +!# item_spec = ServiceSpec(spec_ptrs) item_spec = ServiceSpec(variable_spec, registry) case (MAPL_STATEITEM_WILDCARD%ot) allocate(WildcardSpec :: item_spec) From e747cb13a75688e49f645aba83bac20459a7dd5f Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Thu, 23 Jan 2025 09:44:33 -0500 Subject: [PATCH 11/15] Added ClassAspect method for ordering. --- generic3g/specs/ClassAspect.F90 | 9 +++++++++ generic3g/specs/FieldClassAspect.F90 | 24 ++++++++++++++++++++++-- generic3g/specs/WildcardClassAspect.F90 | 14 +++++++++++++- generic3g/tests/Test_BracketSpec.pf | 3 ++- 4 files changed, 46 insertions(+), 4 deletions(-) diff --git a/generic3g/specs/ClassAspect.F90 b/generic3g/specs/ClassAspect.F90 index 34a9e5006520..091b18219929 100644 --- a/generic3g/specs/ClassAspect.F90 +++ b/generic3g/specs/ClassAspect.F90 @@ -17,6 +17,7 @@ module mapl3g_ClassAspect type, abstract, extends(StateItemAspect) :: ClassAspect contains + procedure(I_get_aspect_order), deferred :: get_aspect_order procedure(I_create), deferred :: create procedure(I_destroy), deferred :: destroy procedure(I_allocate), deferred :: allocate @@ -28,6 +29,14 @@ module mapl3g_ClassAspect abstract interface + function I_get_aspect_order(this, goal_aspects) result(aspect_ids) + use mapl3g_StateItemAspect + import ClassAspect, AspectId + type(AspectId), allocatable :: aspect_ids(:) + class(ClassAspect), intent(in) :: this + type(AspectMap), intent(in) :: goal_aspects + end function I_get_aspect_order + ! Will use ESMF so cannot be PURE subroutine I_create(this, rc) import ClassAspect diff --git a/generic3g/specs/FieldClassAspect.F90 b/generic3g/specs/FieldClassAspect.F90 index 8f17fb5a94ab..57c6fecf72ef 100644 --- a/generic3g/specs/FieldClassAspect.F90 +++ b/generic3g/specs/FieldClassAspect.F90 @@ -45,11 +45,12 @@ module mapl3g_FieldClassAspect character(:), allocatable :: long_name real(kind=ESMF_KIND_R4), allocatable :: default_value contains + procedure :: get_aspect_order + procedure :: supports_conversion_general + procedure :: supports_conversion_specific procedure :: make_action procedure :: make_action2 procedure :: matches - procedure :: supports_conversion_general - procedure :: supports_conversion_specific procedure :: connect_to_export procedure :: create @@ -80,6 +81,25 @@ function new_FieldClassAspect(standard_name, long_name, default_value) result(as end function new_FieldClassAspect + function get_aspect_order(this, goal_aspects) result(aspect_ids) + type(AspectId), allocatable :: aspect_ids(:) + class(FieldClassAspect), intent(in) :: this + type(AspectMap), intent(in) :: goal_aspects + + aspect_ids = [ & + CLASS_ASPECT_ID, & + ATTRIBUTES_ASPECT_ID, & + UNGRIDDED_DIMS_ASPECT_ID, & + GEOM_ASPECT_ID, & + VERTICAL_GRID_ASPECT_ID, & + UNITS_ASPECT_ID, & + TYPEKIND_ASPECT_ID & + ] + + _UNUSED_DUMMY(goal_aspects) + end function get_aspect_order + + subroutine create(this, rc) class(FieldClassAspect), intent(inout) :: this integer, optional, intent(out) :: rc diff --git a/generic3g/specs/WildcardClassAspect.F90 b/generic3g/specs/WildcardClassAspect.F90 index ca927bad3bf6..13990860a198 100644 --- a/generic3g/specs/WildcardClassAspect.F90 +++ b/generic3g/specs/WildcardClassAspect.F90 @@ -30,7 +30,8 @@ module mapl3g_WildcardClassAspect procedure :: make_action procedure :: make_action2 procedure :: connect_to_export - + + procedure :: get_aspect_order procedure :: create procedure :: allocate procedure :: destroy @@ -240,5 +241,16 @@ logical function supports_conversion_specific(src, dst) _UNUSED_DUMMY(dst) end function supports_conversion_specific + ! Cannot be an export - should not call this + function get_aspect_order(this, goal_aspects) result(aspect_ids) + type(AspectId), allocatable :: aspect_ids(:) + class(WildcardClassAspect), intent(in) :: this + type(AspectMap), intent(in) :: goal_aspects + + aspect_ids = [AspectId :: ] ! empty + + _UNUSED_DUMMY(this) + _UNUSED_DUMMY(goal_aspects) + end function get_aspect_order end module mapl3g_WildcardClassAspect diff --git a/generic3g/tests/Test_BracketSpec.pf b/generic3g/tests/Test_BracketSpec.pf index f978b410c783..3b03eb3ab7e9 100644 --- a/generic3g/tests/Test_BracketSpec.pf +++ b/generic3g/tests/Test_BracketSpec.pf @@ -72,7 +72,8 @@ contains end subroutine test_mirror_bracket_size - !@test + @test + @disable ! Verify that once a bracket size mirrors some concrete value it ! can no longer connect to other for bracket size. But can connect to ! specs with bracket size the same as first connection. From d05475bb8c383b2a00cb9636ac229d958d276b60 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Thu, 23 Jan 2025 12:15:58 -0500 Subject: [PATCH 12/15] Added BracketClassAspect Code compiles. Not integrated. --- generic3g/specs/BracketClassAspect.F90 | 304 ++++++++++++++++++++++++ generic3g/specs/CMakeLists.txt | 1 + generic3g/specs/ClassAspect.F90 | 12 +- generic3g/specs/FieldClassAspect.F90 | 5 +- generic3g/specs/ServiceClassAspect.F90 | 252 ++++++++++++++++++++ generic3g/specs/WildcardClassAspect.F90 | 18 +- 6 files changed, 567 insertions(+), 25 deletions(-) create mode 100644 generic3g/specs/BracketClassAspect.F90 create mode 100644 generic3g/specs/ServiceClassAspect.F90 diff --git a/generic3g/specs/BracketClassAspect.F90 b/generic3g/specs/BracketClassAspect.F90 new file mode 100644 index 000000000000..0843751a3364 --- /dev/null +++ b/generic3g/specs/BracketClassAspect.F90 @@ -0,0 +1,304 @@ +#include "MAPL_Generic.h" + +module mapl3g_BracketClassAspect + use mapl3g_ActualConnectionPt + use mapl3g_AspectId + use mapl3g_StateItemAspect + use mapl3g_GeomAspect + use mapl3g_ClassAspect + use mapl3g_FieldClassAspect + use mapl3g_GeomAspect + use mapl3g_VerticalGridAspect + use mapl3g_UnitsAspect + use mapl3g_TypekindAspect + use mapl3g_UngriddedDimsAspect + + use mapl3g_VerticalGrid + use mapl3g_VerticalDimSpec + use mapl3g_VerticalStaggerLoc + use mapl3g_UngriddedDims + + use mapl3g_NullAction + use mapl3g_TimeInterpolateAction + use mapl3g_ExtensionAction + use mapl3g_MultiState + use mapl3g_ESMF_Utilities, only: get_substate + + use mapl3g_FieldCreate + use mapl_FieldUtilities + + use mapl_ErrorHandling + use esmf + implicit none(type,external) + private + + public :: BracketClassAspect + public :: to_BracketClassAspect + + interface to_BracketClassAspect + procedure :: to_BracketClassAspect_from_poly + procedure :: to_BracketClassAspect_from_map + end interface to_BracketClassAspect + + type, extends(ClassAspect) :: BracketClassAspect + private + type(ESMF_FieldBundle) :: payload + type(FieldClassAspect), allocatable :: field_aspects(:) + + integer :: bracket_size ! allocate only if not time dependent + character(:), allocatable :: standard_name + character(:), allocatable :: long_name + + contains + procedure :: get_aspect_order + procedure :: supports_conversion_general + procedure :: supports_conversion_specific + procedure :: make_action + procedure :: make_action2 + procedure :: matches + procedure :: connect_to_export + + procedure :: create + procedure :: allocate + procedure :: destroy + procedure :: add_to_state + + end type BracketClassAspect + + interface BracketClassAspect + procedure :: new_BracketClassAspect + end interface BracketClassAspect + +contains + + function new_BracketClassAspect(bracket_size, standard_name, long_name) result(aspect) + type(BracketClassAspect) :: aspect + integer, intent(in) :: bracket_size + character(*), intent(in) :: standard_name + character(*), intent(in) :: long_name + + aspect%bracket_size = bracket_size + aspect%standard_name = standard_name + aspect%long_name = long_name + + end function new_BracketClassAspect + + function get_aspect_order(this, goal_aspects, rc) result(aspect_ids) + type(AspectId), allocatable :: aspect_ids(:) + class(BracketClassAspect), intent(in) :: this + type(AspectMap), intent(in) :: goal_aspects + integer, optional, intent(out) :: rc + + integer :: status + type(GeomAspect) :: geom_aspect + + geom_aspect = to_GeomAspect(goal_aspects, _RC) + if (geom_aspect%is_time_dependent()) then + ! must do time interpolation first + aspect_ids = [ & + CLASS_ASPECT_ID, & + GEOM_ASPECT_ID & + ] + end if + + ! Othrerwise doing geom regrid first is a performance improveent. + aspect_ids = [ & + GEOM_ASPECT_ID, & + CLASS_ASPECT_ID & + ] + + _RETURN(_SUCCESS) + _UNUSED_DUMMY(goal_aspects) + end function get_aspect_order + + subroutine create(this, rc) + class(BracketClassAspect), intent(inout) :: this + integer, optional, intent(out) :: rc + + integer :: status + + this%payload = ESMF_FieldBundleCreate(_RC) + + _RETURN(_SUCCESS) + end subroutine create + + ! Tile / Grid X or X, Y + subroutine allocate(this, other_aspects, rc) + class(BracketClassAspect), intent(inout) :: this + type(AspectMap), intent(in) :: other_aspects + integer, optional, intent(out) :: rc + + integer :: status + integer :: i + + associate (n => this%bracket_size) + allocate(this%field_aspects(n)) + + do i = 1, n + this%field_aspects(i) = FieldClassAspect(this%standard_name, this%long_name) + associate (field => this%field_aspects(i)) + call field%create(_RC) + call field%allocate(other_aspects, _RC) + call field%add_to_bundle(this%payload, _RC) + end associate + end do + end associate + + _RETURN(_SUCCESS) + + contains + + function int_to_string(i) result(s) + character(:), allocatable :: s + integer, intent(in) :: i + character(len=20) :: buffer + write(buffer, '(i0)') i + s = trim(buffer) + end function int_to_string + + end subroutine allocate + + + subroutine destroy(this, rc) + class(BracketClassAspect), intent(inout) :: this + integer, optional, intent(out) :: rc + + integer :: status + integer :: i + + do i = 1, size(this%field_aspects) + call this%field_aspects(i)%destroy(_RC) + end do + call ESMF_FieldBundleDestroy(this%payload, noGarbage=.true., _RC) + + _RETURN(_SUCCESS) + end subroutine destroy + + + subroutine connect_to_export(this, export, actual_pt, rc) + class(BracketClassAspect), intent(inout) :: this + class(StateItemAspect), intent(in) :: export + type(ActualConnectionPt), intent(in) :: actual_pt + integer, optional, intent(out) :: rc + + + _FAIL("BracketClassAspect cannot be an import") + + _UNUSED_DUMMY(this) + _UNUSED_DUMMY(export) + _UNUSED_DUMMY(actual_pt) + end subroutine connect_to_export + + + function to_BracketClassAspect_from_poly(aspect, rc) result(bracket_aspect) + type(BracketClassAspect) :: bracket_aspect + class(StateItemAspect), intent(in) :: aspect + integer, optional, intent(out) :: rc + + integer :: status + + select type(aspect) + class is (BracketClassAspect) + bracket_aspect = aspect + class default + _FAIL('aspect is not BracketClassAspect') + end select + + _RETURN(_SUCCESS) + end function to_BracketClassAspect_from_poly + + function to_BracketClassAspect_from_map(map, rc) result(bracket_aspect) + type(BracketClassAspect) :: bracket_aspect + type(AspectMap), target, intent(in) :: map + integer, optional, intent(out) :: rc + + integer :: status + class(StateItemAspect), pointer :: poly + + poly => map%at(CLASS_ASPECT_ID, _RC) + bracket_aspect = to_BracketClassAspect(poly, _RC) + + _RETURN(_SUCCESS) + end function to_BracketClassAspect_from_map + + + function make_action(src, dst, rc) result(action) + class(ExtensionAction), allocatable :: action + class(BracketClassAspect), intent(in) :: src + class(StateItemAspect), intent(in) :: dst + integer, optional, intent(out) :: rc + + action = TimeInterpolateAction() + _RETURN(_SUCCESS) + end function make_action + + function make_action2(src, dst, other_aspects, rc) result(action) + class(ExtensionAction), allocatable :: action + class(BracketClassAspect), intent(in) :: src + class(StateItemAspect), intent(in) :: dst + type(AspectMap), target, intent(in) :: other_aspects + integer, optional, intent(out) :: rc + + ! No arguments to constructor - it uses ESMF_Info + ! and FieldBundle structure to determine what to do + action = TimeInterpolateAction() + + _RETURN(_SUCCESS) + end function make_action2 + + ! Should only connect to FieldClassAspect and + ! then needs a TimeInterpolateAction + logical function matches(src, dst) + class(BracketClassAspect), intent(in) :: src + class(StateItemAspect), intent(in) :: dst + + matches = .false. + + end function matches + + logical function supports_conversion_general(src) + class(BracketClassAspect), intent(in) :: src + supports_conversion_general = .true. + end function supports_conversion_general + + ! Only can convert if import is FieldClassAspect. + logical function supports_conversion_specific(src, dst) + class(BracketClassAspect), intent(in) :: src + class(StateItemAspect), intent(in) :: dst + + supports_conversion_specific = .false. + select type (dst) + type is (FieldClassAspect) + supports_conversion_specific = .true. + end select + + _UNUSED_DUMMY(dst) + end function supports_conversion_specific + + subroutine add_to_state(this, multi_state, actual_pt, rc) + class(BracketClassAspect), intent(in) :: this + type(MultiState), intent(inout) :: multi_state + type(ActualConnectionPt), intent(in) :: actual_pt + integer, optional, intent(out) :: rc + + type(ESMF_Field) :: alias + integer :: status + type(ESMF_State) :: state, substate + character(:), allocatable :: full_name, inner_name + integer :: idx + +!# call multi_state%get_state(state, actual_pt%get_state_intent(), _RC) +!# +!# full_name = actual_pt%get_full_name() +!# idx = index(full_name, '/', back=.true.) +!# call get_substate(state, full_name(:idx-1), substate=substate, _RC) +!# inner_name = full_name(idx+1:) +!# +!# alias = ESMF_NamedAlias(this%payload, name=inner_name, _RC) +!# call ESMF_StateAdd(substate, [alias], _RC) + + _RETURN(_SUCCESS) + end subroutine add_to_state + + +end module mapl3g_BracketClassAspect diff --git a/generic3g/specs/CMakeLists.txt b/generic3g/specs/CMakeLists.txt index 4ccdda6d6e9e..9e9d66ef53fd 100644 --- a/generic3g/specs/CMakeLists.txt +++ b/generic3g/specs/CMakeLists.txt @@ -5,6 +5,7 @@ target_sources(MAPL.generic3g PRIVATE FieldClassAspect.F90 WildcardClassAspect.F90 ServiceClassAspect.F90 + BracketClassAspect.F90 AspectCollection.F90 AttributesAspect.F90 diff --git a/generic3g/specs/ClassAspect.F90 b/generic3g/specs/ClassAspect.F90 index 091b18219929..f69a5549a185 100644 --- a/generic3g/specs/ClassAspect.F90 +++ b/generic3g/specs/ClassAspect.F90 @@ -23,18 +23,18 @@ module mapl3g_ClassAspect procedure(I_allocate), deferred :: allocate procedure(I_add_to_state), deferred :: add_to_state - procedure(I_add_to_bundle), deferred :: add_to_bundle procedure, non_overridable, nopass :: get_aspect_id end type ClassAspect abstract interface - function I_get_aspect_order(this, goal_aspects) result(aspect_ids) + function I_get_aspect_order(this, goal_aspects, rc) result(aspect_ids) use mapl3g_StateItemAspect import ClassAspect, AspectId type(AspectId), allocatable :: aspect_ids(:) class(ClassAspect), intent(in) :: this type(AspectMap), intent(in) :: goal_aspects + integer, optional, intent(out) :: rc end function I_get_aspect_order ! Will use ESMF so cannot be PURE @@ -69,14 +69,6 @@ subroutine I_add_to_state(this, multi_state, actual_pt, rc) integer, optional, intent(out) :: rc end subroutine I_add_to_state - subroutine I_add_to_bundle(this, field_bundle, rc) - use ESMF, only: ESMF_FieldBundle - import ClassAspect - class(ClassAspect), intent(in) :: this - type(ESMF_FieldBundle), intent(inout) :: field_bundle - integer, optional, intent(out) :: rc - end subroutine I_add_to_bundle - end interface contains diff --git a/generic3g/specs/FieldClassAspect.F90 b/generic3g/specs/FieldClassAspect.F90 index 57c6fecf72ef..ed910842de57 100644 --- a/generic3g/specs/FieldClassAspect.F90 +++ b/generic3g/specs/FieldClassAspect.F90 @@ -81,10 +81,11 @@ function new_FieldClassAspect(standard_name, long_name, default_value) result(as end function new_FieldClassAspect - function get_aspect_order(this, goal_aspects) result(aspect_ids) + function get_aspect_order(this, goal_aspects, rc) result(aspect_ids) type(AspectId), allocatable :: aspect_ids(:) class(FieldClassAspect), intent(in) :: this type(AspectMap), intent(in) :: goal_aspects + integer, optional, intent(out) :: rc aspect_ids = [ & CLASS_ASPECT_ID, & @@ -96,6 +97,8 @@ function get_aspect_order(this, goal_aspects) result(aspect_ids) TYPEKIND_ASPECT_ID & ] + _RETURN(_SUCCESS) + _UNUSED_DUMMY(goal_aspects) end function get_aspect_order diff --git a/generic3g/specs/ServiceClassAspect.F90 b/generic3g/specs/ServiceClassAspect.F90 new file mode 100644 index 000000000000..adb33882363d --- /dev/null +++ b/generic3g/specs/ServiceClassAspect.F90 @@ -0,0 +1,252 @@ +#include "MAPL_Generic.h" + +module mapl3g_ServiceClassAspect + use mapl3g_AspectId + use mapl3g_StateItemAspect + use mapl3g_ClassAspect + use mapl3g_FieldClassAspect + use mapl3g_StateRegistry + use mapl3g_StateItemSpec + use mapl3g_Multistate + use mapl3g_VirtualConnectionPt + use mapl3g_ActualConnectionPt + use mapl3g_ExtensionAction + use mapl3g_StateItemExtension + use mapl3g_NullAction + use mapl3g_ESMF_Utilities, only: get_substate + use mapl_ErrorHandling + use gftl2_StringVector + use esmf + implicit none + private + + public :: ServiceClassAspect + + type, extends(ClassAspect) :: ServiceClassAspect + type(ESMF_FieldBundle) :: payload + + class(StateItemSpec), allocatable :: reference_spec + + ! Associtaed with subscriber + type(StateRegistry), pointer :: registry => null() + type(StringVector) :: subscriber_item_names + + ! Associated with provider + type(StateItemSpecPtr), allocatable :: items_to_service(:) + contains + procedure :: supports_conversion_general + procedure :: supports_conversion_specific + procedure :: matches + procedure :: make_action + procedure :: make_action2 + procedure :: connect_to_export + + procedure :: get_aspect_order + procedure :: create + procedure :: allocate + procedure :: destroy + procedure :: add_to_state + end type ServiceClassAspect + + interface ServiceClassAspect + procedure new_ServiceClassAspect + end interface ServiceClassAspect + +contains + + function new_ServiceClassAspect(registry, subscriber_item_names) result(service_aspect) + type(ServiceClassAspect) :: service_aspect + type(StateRegistry), optional, target, intent(in) :: registry + type(StringVector), optional, intent(in) :: subscriber_item_names + + if (present(registry)) then + service_aspect%registry => registry + end if + + if (present(subscriber_item_names)) then + service_aspect%subscriber_item_names = subscriber_item_names + end if + + end function new_ServiceClassAspect + + logical function supports_conversion_general(src) + class(ServiceClassAspect), intent(in) :: src + supports_conversion_general = .false. + _UNUSED_DUMMY(src) + end function supports_conversion_general + + logical function supports_conversion_specific(src, dst) + class(ServiceClassAspect), intent(in) :: src + class(StateItemAspect), intent(in) :: dst + + supports_conversion_specific = .false. + + _UNUSED_DUMMY(src) + _UNUSED_DUMMY(dst) + end function supports_conversion_specific + + + subroutine create(this, rc) + class(ServiceClassAspect), intent(inout) :: this + integer, optional, intent(out) :: rc + + integer :: status + + this%payload = ESMF_FieldBundleCreate(_RC) + + _RETURN(_SUCCESS) + end subroutine create + + subroutine destroy(this, rc) + class(ServiceClassAspect), intent(inout) :: this + integer, optional, intent(out) :: rc + + integer :: status + + call ESMF_FieldBundleDestroy(this%payload, noGarbage=.true., _RC) + + _RETURN(ESMF_SUCCESS) + end subroutine destroy + + subroutine allocate(this, other_aspects, rc) + class(ServiceClassAspect), intent(inout) :: this + type(AspectMap), intent(in) :: other_aspects + + integer, optional, intent(out) :: rc + + integer :: status + integer :: i + type(FieldClassAspect) :: field_aspect + class(StateItemAspect), pointer :: aspect + class(StateItemSpec), pointer :: spec + + associate (specs => this%items_to_service) + do i = 1, size(specs) + spec => specs(i)%ptr + aspect => spec%get_aspect(CLASS_ASPECT_ID, _RC) + field_aspect = to_FieldClassAspect(aspect, _RC) + call field_aspect%add_to_bundle(this%payload, _RC) + end do + end associate + + _RETURN(_SUCCESS) + end subroutine allocate + + subroutine add_to_state(this, multi_state, actual_pt, rc) + class(ServiceClassAspect), intent(in) :: this + type(MultiState), intent(inout) :: multi_state + type(ActualConnectionPt), intent(in) :: actual_pt + integer, optional, intent(out) :: rc + + type(ESMF_FieldBundle) :: alias + character(:), allocatable :: short_name + type(ESMF_State) :: substate + integer :: status + + short_name = actual_pt%get_esmf_name() + alias = ESMF_NamedAlias(this%payload, name=short_name, _RC) + + ! Add bundle to both import and export specs. + call get_substate(multi_state%importstate, actual_pt%get_comp_name(), substate=substate, _RC) + call ESMF_StateAdd(substate, [alias], _RC) + call get_substate(multi_state%exportstate, actual_pt%get_comp_name(), substate=substate, _RC) + call ESMF_StateAdd(substate, [alias], _RC) + + _RETURN(_SUCCESS) + end subroutine add_to_state + + + logical function matches(src, dst) + class(ServiceClassAspect), intent(in) :: src + class(StateItemAspect), intent(in) :: dst + + matches = .false. + select type(dst) + type is (ServiceClassAspect) + matches = .true. + end select + + end function matches + + function make_action(src, dst, rc) result(action) + class(ExtensionAction), allocatable :: action + class(ServiceClassAspect), intent(in) :: src + class(StateItemAspect), intent(in) :: dst + integer, optional, intent(out) :: rc + + action = NullAction() + _RETURN(_SUCCESS) + end function make_action + + function make_action2(src, dst, other_aspects, rc) result(action) + class(ExtensionAction), allocatable :: action + class(ServiceClassAspect), intent(in) :: src + class(StateItemAspect), intent(in) :: dst + type(AspectMap), target, intent(in) :: other_aspects + integer, optional, intent(out) :: rc + + action = NullAction() + + _RETURN(_SUCCESS) + end function make_action2 + + + subroutine connect_to_export(this, export, actual_pt, rc) + class(ServiceClassAspect), intent(inout) :: this + class(StateItemAspect), intent(in) :: export + type(ActualConnectionPt), intent(in) :: actual_pt + integer, optional, intent(out) :: rc + + _FAIL('Service cannot be an import.') + + end subroutine connect_to_export + + subroutine connect_to_import(this, import, rc) + class(ServiceClassAspect), intent(inout) :: this + class(StateItemAspect), intent(in) :: import + integer, optional, intent(out) :: rc + + integer :: status + integer :: i, n + type(StateItemSpecPtr), allocatable :: spec_ptrs(:) + type(VirtualConnectionPt) :: v_pt + type(StateItemExtension), pointer :: primary + + select type (import) + type is (ServiceClassAspect) + + associate (item_names => import%subscriber_item_names) + n = item_names%size() + allocate(spec_ptrs(n)) + do i = 1, n + v_pt = VirtualConnectionPt(ESMF_STATEINTENT_INTERNAL, item_names%of(i)) + ! Internal items are always unique and "primary" (owned by user) + primary => import%registry%get_primary_extension(v_pt, _RC) + spec_ptrs(i)%ptr => primary%get_spec() + end do + end associate + + this%items_to_service = [this%items_to_service, spec_ptrs] + class default + _FAIL('Import must be a Service') + end select + + _RETURN(_SUCCESS) + end subroutine connect_to_import + + function get_aspect_order(this, goal_aspects, rc) result(aspect_ids) + type(AspectId), allocatable :: aspect_ids(:) + class(ServiceClassAspect), intent(in) :: this + type(AspectMap), intent(in) :: goal_aspects + integer, optional, intent(out) :: rc + + aspect_ids = [CLASS_ASPECT_ID] + + _RETURN(_SUCCESS) + + _UNUSED_DUMMY(this) + _UNUSED_DUMMY(goal_aspects) + end function get_aspect_order + + +end module mapl3g_ServiceClassAspect diff --git a/generic3g/specs/WildcardClassAspect.F90 b/generic3g/specs/WildcardClassAspect.F90 index 13990860a198..cda6da842d4c 100644 --- a/generic3g/specs/WildcardClassAspect.F90 +++ b/generic3g/specs/WildcardClassAspect.F90 @@ -36,7 +36,6 @@ module mapl3g_WildcardClassAspect procedure :: allocate procedure :: destroy procedure :: add_to_state - procedure :: add_to_bundle end type WildcardClassAspect @@ -214,18 +213,6 @@ end subroutine with_target_attribute end subroutine add_to_state - subroutine add_to_bundle(this, field_bundle, rc) - class(WildcardClassAspect), intent(in) :: this - type(ESMF_FieldBundle), intent(inout) :: field_bundle - integer, optional, intent(out) :: rc - - integer :: status - - _FAIL('Wildcard cannot be added to a bundle.') - - _RETURN(_SUCCESS) - end subroutine add_to_bundle - ! Wildcard is never an export logical function supports_conversion_general(src) class(WildcardClassAspect), intent(in) :: src @@ -242,13 +229,16 @@ logical function supports_conversion_specific(src, dst) end function supports_conversion_specific ! Cannot be an export - should not call this - function get_aspect_order(this, goal_aspects) result(aspect_ids) + function get_aspect_order(this, goal_aspects, rc) result(aspect_ids) type(AspectId), allocatable :: aspect_ids(:) class(WildcardClassAspect), intent(in) :: this type(AspectMap), intent(in) :: goal_aspects + integer, optional, intent(out) :: rc aspect_ids = [AspectId :: ] ! empty + _RETURN(_SUCCESS) + _UNUSED_DUMMY(this) _UNUSED_DUMMY(goal_aspects) end function get_aspect_order From 260d563d08ff0d3e8436ec33ed98a362110e731b Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 23 Jan 2025 13:35:20 -0500 Subject: [PATCH 13/15] Update changelog --- CHANGELOG.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index ef026ba9b20a..25e2e361ff82 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,10 +10,13 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added ### Changed + - Updated ExtData so that if files are missing in a sequence the last value will be perisisted if one has not chosen `exact` option ### Fixed +- Changes were made to add attributes to the subgrids (i.e. created by dividing the MPI subdomain into smaller subdomains equal to the number of OpenMP threads) such that the correct dimensions for the MPI subdomain could be retrieved from the subgrids where ever needed. + ### Removed ### Deprecated From beebb2927b831a2cc605386e7d1c0bec9f58eef6 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 24 Jan 2025 10:49:40 -0500 Subject: [PATCH 14/15] Prepare for 2.53.0 Release --- CHANGELOG.md | 14 ++++++++++---- CMakeLists.txt | 2 +- 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6a15e7a69c76..5277ee59e9f8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,16 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed +### Fixed + +### Removed + +### Deprecated + +## [2.53.0] - 2025-01-24 + +### Changed + - Updated ExtData so that if files are missing in a sequence the last value will be perisisted if one has not chosen `exact` option - Update `components.yaml` - `ESMA_env` v4.34.1 @@ -20,10 +30,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Changes were made to add attributes to the subgrids (i.e. created by dividing the MPI subdomain into smaller subdomains equal to the number of OpenMP threads) such that the correct dimensions for the MPI subdomain could be retrieved from the subgrids where ever needed. -### Removed - -### Deprecated - ## [2.52.0] - 2025-01-17 ### Added diff --git a/CMakeLists.txt b/CMakeLists.txt index 83113960be62..4e8f157d3579 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -8,7 +8,7 @@ endif () project ( MAPL - VERSION 2.52.0 + VERSION 2.53.0 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF # Set the possible values of build type for cmake-gui From 21fb985ebdf14f4373f5a7a87d5ee3b923991d58 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 24 Jan 2025 12:09:56 -0500 Subject: [PATCH 15/15] Convert to ESMF_Info --- base/Base/Base_Base_implementation.F90 | 12 ++++++++---- base/MaplGrid.F90 | 5 +++-- generic/OpenMP_Support.F90 | 3 +-- 3 files changed, 12 insertions(+), 8 deletions(-) diff --git a/base/Base/Base_Base_implementation.F90 b/base/Base/Base_Base_implementation.F90 index 71f6099fa60c..44fce0ba82a3 100644 --- a/base/Base/Base_Base_implementation.F90 +++ b/base/Base/Base_Base_implementation.F90 @@ -1574,15 +1574,17 @@ module subroutine MAPL_GRID_INTERIOR(GRID,I1,IN,J1,JN) integer :: rc logical :: isPresent integer :: global_grid_info(10) + type(ESMF_Info) :: infoh i1=-1 j1=-1 in=-1 jn=-1 - call ESMF_AttributeGet(grid, name="GLOBAL_GRID_INFO", isPresent=isPresent, _RC) + call ESMF_InfoGetFromHost(grid,infoh,_RC) + isPresent = ESMF_InfoIsPresent(infoh,'GLOBAL_GRID_INFO',_RC) if (isPresent) then - call ESMF_AttributeGet(grid, name="GLOBAL_GRID_INFO", valueList=global_grid_info, _RC) + call ESMF_InfoGet(infoh, key="GLOBAL_GRID_INFO", values=global_grid_info, _RC) I1 = global_grid_info(7) IN = global_grid_info(8) j1 = global_grid_info(9) @@ -2165,15 +2167,17 @@ module subroutine MAPL_GridGetInterior(GRID,I1,IN,J1,JN) integer :: rc logical :: isPresent integer :: global_grid_info(10) + type(ESMF_Info) :: infoh i1=-1 j1=-1 in=-1 jn=-1 - call ESMF_AttributeGet(grid, name="GLOBAL_GRID_INFO", isPresent=isPresent, _RC) + call ESMF_InfoGetFromHost(grid,infoh,_RC) + isPresent = ESMF_InfoIsPresent(infoh,'GLOBAL_GRID_INFO',_RC) if (isPresent) then - call ESMF_AttributeGet(grid, name="GLOBAL_GRID_INFO", valueList=global_grid_info, _RC) + call ESMF_InfoGet(infoh, key="GLOBAL_GRID_INFO", values=global_grid_info, _RC) I1 = global_grid_info(7) IN = global_grid_info(8) j1 = global_grid_info(9) diff --git a/base/MaplGrid.F90 b/base/MaplGrid.F90 index d6495084030a..0418509191af 100644 --- a/base/MaplGrid.F90 +++ b/base/MaplGrid.F90 @@ -271,9 +271,10 @@ subroutine MAPL_GridGet(GRID, globalCellCountPerDim, localCellCountPerDim, layou pglobal = present(globalCellCountPerDim) plocal = present(localCellCountPerDim) - call ESMF_AttributeGet(grid, name="GLOBAL_GRID_INFO", isPresent=isPresent, _RC) + call ESMF_InfoGetFromHost(grid,infoh,_RC) + isPresent = ESMF_InfoIsPresent(infoh,'GLOBAL_GRID_INFO',_RC) if (isPresent) then - call ESMF_AttributeGet(grid, name="GLOBAL_GRID_INFO", valueList=global_grid_info, _RC) + call ESMF_InfoGet(infoh, key="GLOBAL_GRID_INFO", values=global_grid_info, _RC) if (pglobal) globalCellCountPerDim = global_grid_info(1:3) if (plocal) localCellCountPerDim = global_grid_info(4:6) _RETURN(_SUCCESS) diff --git a/generic/OpenMP_Support.F90 b/generic/OpenMP_Support.F90 index 59965d86f5f6..59f5390c683c 100644 --- a/generic/OpenMP_Support.F90 +++ b/generic/OpenMP_Support.F90 @@ -193,8 +193,7 @@ function make_subgrids_from_bounds(primary_grid, bounds, unusable, rc) result(su global_grid_info(8) = i2 global_grid_info(9) = j1 + bounds(i)%min - 1 global_grid_info(10) = j1 + bounds(i)%max - 1 - call ESMF_AttributeSet(subgrids(i), name="GLOBAL_GRID_INFO", & - itemCount=10, valueList=global_grid_info, _RC) + call ESMF_InfoSet(infoh, key="GLOBAL_GRID_INFO", values=global_grid_info, _RC) end block deallocate(lons1d, lats1d)