Skip to content

Commit 0c40ae4

Browse files
pchakrabortypchakraborty
authored
Add real64 cases to FieldBundleGetPointer (#4948)
* Add real64 cases to FieldBundleGetPointer * Update CHANGELOG for REAL64 FieldBundleGetPointer cases * Add tests for REAL64 FieldBundleGetPointer cases * Fix FieldBundleGetPointer REAL64 tests
1 parent 4564272 commit 0c40ae4

3 files changed

Lines changed: 233 additions & 10 deletions

File tree

‎CHANGELOG.md‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
2020

2121
### Added
2222
- Extended StatisticsGridComp to support variance of a single field.
23+
- Extended `FieldBundleGetPointerToData` interface with REAL64 pointer overloads
24+
for index/name and 2D/3D variants (PR #4948).
2325

2426
### Changed
2527

‎infrastructure/fields/field_bundle/FieldBundleGetPointer.F90‎

Lines changed: 94 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ module mapl3g_FieldBundleGetPointer
55

66
use ESMF
77
use MAPL_ErrorHandling
8-
use, intrinsic :: iso_fortran_env, only: real32, real64
8+
use, intrinsic :: iso_fortran_env, only: REAL64
99

1010
implicit none(type,external)
1111
private
@@ -17,6 +17,10 @@ module mapl3g_FieldBundleGetPointer
1717
module procedure FieldBundleGetPointerToDataByIndex3
1818
module procedure FieldBundleGetPointerToDataByName2
1919
module procedure FieldBundleGetPointerToDataByName3
20+
module procedure FieldBundleGetPointerToR8DataByIndex2
21+
module procedure FieldBundleGetPointerToR8DataByIndex3
22+
module procedure FieldBundleGetPointerToR8DataByName2
23+
module procedure FieldBundleGetPointerToR8DataByName3
2024
end interface FieldBundleGetPointerToData
2125

2226
contains
@@ -35,10 +39,9 @@ subroutine FieldBundleGetPointerToDataByIndex2(bundle, index, ptr, rc)
3539

3640
call ESMF_FieldBundleGet(bundle, index, field, _RC)
3741
call ESMF_FieldGet(field, status=field_status, _RC)
42+
nullify(ptr)
3843
if (field_status == ESMF_FIELDSTATUS_COMPLETE) then
3944
call ESMF_FieldGet(field, 0, ptr, _RC)
40-
else
41-
nullify(ptr)
4245
end if
4346

4447
_RETURN(_SUCCESS)
@@ -58,10 +61,9 @@ subroutine FieldBundleGetPointerToDataByIndex3(bundle, index, ptr, rc)
5861

5962
call ESMF_FieldBundleGet(bundle, index, field, _RC)
6063
call ESMF_FieldGet(field, status=field_status, _RC)
64+
nullify(ptr)
6165
if (field_status == ESMF_FIELDSTATUS_COMPLETE) then
6266
call ESMF_FieldGet(field, 0, ptr, _RC)
63-
else
64-
nullify(ptr)
6567
end if
6668

6769
_RETURN(_SUCCESS)
@@ -79,16 +81,15 @@ subroutine FieldBundleGetPointerToDataByName2(bundle, name, ptr, rc)
7981

8082
call ESMF_FieldBundleGet(bundle, name, field=field, _RC)
8183
call ESMF_FieldGet(field, status=field_status, _RC)
84+
nullify(ptr)
8285
if (field_status == ESMF_FIELDSTATUS_COMPLETE) then
8386
call ESMF_FieldGet(field, 0, ptr, _RC)
84-
else
85-
nullify(ptr)
8687
end if
8788

8889
_RETURN(_SUCCESS)
8990
end subroutine FieldBundleGetPointerToDataByName2
9091

91-
subroutine FieldBundleGetPointerToDataByName3(BUNDLE,NAME,PTR,RC)
92+
subroutine FieldBundleGetPointerToDataByName3(bundle, name, ptr, rc)
9293
type(ESMF_FieldBundle), intent(inout) :: bundle !ALT: intent(in)
9394
character(len=*), intent(in) :: name
9495
real, pointer, intent(inout) :: ptr(:,:,:)
@@ -100,13 +101,96 @@ subroutine FieldBundleGetPointerToDataByName3(BUNDLE,NAME,PTR,RC)
100101

101102
call ESMF_FieldBundleGet(bundle, name, field=field, _RC)
102103
call ESMF_FieldGet(field, status=field_status, _RC)
104+
nullify(ptr)
103105
if (field_status == ESMF_FIELDSTATUS_COMPLETE) then
104106
call ESMF_FieldGet(field, 0, ptr, _RC)
105-
else
106-
nullify(ptr)
107107
end if
108108

109109
_RETURN(_SUCCESS)
110110
end subroutine FieldBundleGetPointerToDataByName3
111111

112+
subroutine FieldBundleGetPointerToR8DataByIndex2(bundle, index, ptr, rc)
113+
type(ESMF_FieldBundle), intent(inout) :: bundle !ALT: intent(in)
114+
integer, intent(in) :: index
115+
real(REAL64), pointer, intent(inout) :: ptr(:,:)
116+
integer, optional, intent(out):: rc
117+
118+
type(ESMF_Field) :: field
119+
type(ESMF_FieldStatus_Flag) :: field_status
120+
integer :: status
121+
122+
! ESMF 5 reorders items, be careful!
123+
124+
call ESMF_FieldBundleGet(bundle, index, field, _RC)
125+
call ESMF_FieldGet(field, status=field_status, _RC)
126+
nullify(ptr)
127+
if (field_status == ESMF_FIELDSTATUS_COMPLETE) then
128+
call ESMF_FieldGet(field, 0, ptr, _RC)
129+
end if
130+
131+
_RETURN(_SUCCESS)
132+
end subroutine FieldBundleGetPointerToR8DataByIndex2
133+
134+
subroutine FieldBundleGetPointerToR8DataByIndex3(bundle, index, ptr, rc)
135+
type(ESMF_FieldBundle), intent(inout) :: bundle !ALT: intent(in)
136+
integer, intent(in) :: index
137+
real(REAL64), pointer, intent(inout) :: ptr(:,:,:)
138+
integer, optional, intent(out):: rc
139+
140+
type(ESMF_Field) :: field
141+
type(ESMF_FieldStatus_Flag) :: field_status
142+
integer :: status
143+
144+
! ESMF 5 reorders items, be careful!
145+
146+
call ESMF_FieldBundleGet(bundle, index, field, _RC)
147+
call ESMF_FieldGet(field, status=field_status, _RC)
148+
nullify(ptr)
149+
if (field_status == ESMF_FIELDSTATUS_COMPLETE) then
150+
call ESMF_FieldGet(field, 0, ptr, _RC)
151+
end if
152+
153+
_RETURN(_SUCCESS)
154+
end subroutine FieldBundleGetPointerToR8DataByIndex3
155+
156+
subroutine FieldBundleGetPointerToR8DataByName2(bundle, name, ptr, rc)
157+
type(ESMF_FieldBundle), intent(inout) :: bundle !ALT: intent(in)
158+
character(len=*), intent(in) :: name
159+
real(REAL64), pointer, intent(inout) :: ptr(:,:)
160+
integer, optional, intent(out):: rc
161+
162+
type(ESMF_Field) :: field
163+
type(ESMF_FieldStatus_Flag) :: field_status
164+
integer :: status
165+
166+
call ESMF_FieldBundleGet(bundle, name, field=field, _RC)
167+
call ESMF_FieldGet(field, status=field_status, _RC)
168+
nullify(ptr)
169+
if (field_status == ESMF_FIELDSTATUS_COMPLETE) then
170+
call ESMF_FieldGet(field, 0, ptr, _RC)
171+
end if
172+
173+
_RETURN(_SUCCESS)
174+
end subroutine FieldBundleGetPointerToR8DataByName2
175+
176+
subroutine FieldBundleGetPointerToR8DataByName3(bundle, name, ptr, rc)
177+
type(ESMF_FieldBundle), intent(inout) :: bundle !ALT: intent(in)
178+
character(len=*), intent(in) :: name
179+
real(REAL64), pointer, intent(inout) :: ptr(:,:,:)
180+
integer, optional, intent(out):: rc
181+
182+
type(ESMF_Field) :: field
183+
type(ESMF_FieldStatus_Flag) :: field_status
184+
integer :: status
185+
186+
call ESMF_FieldBundleGet(bundle, name, field=field, _RC)
187+
call ESMF_FieldGet(field, status=field_status, _RC)
188+
nullify(ptr)
189+
if (field_status == ESMF_FIELDSTATUS_COMPLETE) then
190+
call ESMF_FieldGet(field, 0, ptr, _RC)
191+
end if
192+
193+
_RETURN(_SUCCESS)
194+
end subroutine FieldBundleGetPointerToR8DataByName3
195+
112196
end module mapl3g_FieldBundleGetPointer

‎infrastructure/fields/field_bundle/tests/Test_FieldBundleGetPointer.pf‎

Lines changed: 137 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@ module Test_FieldBundleGetPointer
88
use mapl3g_FieldBundleGetPointer
99
use MAPL_ErrorHandling, only: MAPL_Verify
1010
use ESMF
11+
use, intrinsic :: iso_fortran_env, only: REAL64
1112
use pfunit
1213
use ESMF_TestMethod_mod
1314

@@ -332,4 +333,140 @@ contains
332333
_UNUSED_DUMMY(this)
333334
end subroutine test_GetPointerByName3D_Actual3D
334335

336+
! Test getting REAL64 pointer by index for 2D field
337+
@Test(type=ESMF_TestMethod, npes=[1])
338+
subroutine test_GetPointerByIndex2D_Real64(this)
339+
class(ESMF_TestMethod), intent(inout) :: this
340+
341+
type(ESMF_FieldBundle) :: bundle
342+
type(ESMF_Field) :: field1, field2
343+
type(ESMF_Grid) :: grid
344+
real(REAL64), pointer :: ptr(:,:)
345+
integer :: rc, status
346+
type(ESMF_TypeKind_Flag), parameter :: typekind = ESMF_TYPEKIND_R8
347+
348+
! Create fields
349+
call ESMF_FieldGet(original, grid=grid, _RC)
350+
field1 = ESMF_FieldCreate(grid, typekind, _RC)
351+
field2 = ESMF_FieldCreate(grid, typekind, _RC)
352+
bundle = ESMF_FieldBundleCreate(fieldList=[field1, field2], _RC)
353+
354+
! Get pointer by index using REAL64
355+
call FieldBundleGetPointerToData(bundle, 1, ptr, rc=status)
356+
@assertEqual(status, _SUCCESS, 'Failed to get REAL64 pointer by index for 2D field')
357+
358+
! Verify we got a pointer
359+
@assertTrue(associated(ptr), 'REAL64 pointer should be associated')
360+
nullify(ptr)
361+
362+
call ESMF_FieldDestroy(field1, _RC)
363+
call ESMF_FieldDestroy(field2, _RC)
364+
call ESMF_FieldBundleDestroy(bundle, _RC)
365+
366+
_UNUSED_DUMMY(this)
367+
end subroutine test_GetPointerByIndex2D_Real64
368+
369+
! Test getting REAL64 pointer by index for 3D field
370+
@Test(type=ESMF_TestMethod, npes=[1])
371+
subroutine test_GetPointerByIndex3D_Real64(this)
372+
class(ESMF_TestMethod), intent(inout) :: this
373+
374+
type(ESMF_FieldBundle) :: bundle
375+
type(ESMF_Field) :: field1, field2
376+
type(ESMF_Grid) :: grid
377+
real(REAL64), pointer :: ptr(:,:,:)
378+
integer :: rc, status
379+
type(ESMF_TypeKind_Flag), parameter :: typekind = ESMF_TYPEKIND_R8
380+
381+
call ESMF_FieldGet(original, grid=grid, _RC)
382+
! Create actual 3D fields
383+
field1 = ESMF_FieldCreate(grid, typekind, ungriddedLBound=[1], ungriddedUBound=[3], _RC)
384+
field2 = ESMF_FieldCreate(grid, typekind, ungriddedLBound=[1], ungriddedUBound=[3], _RC)
385+
bundle = ESMF_FieldBundleCreate(fieldList=[field1, field2], _RC)
386+
387+
! Get REAL64 pointer by index
388+
call FieldBundleGetPointerToData(bundle, 1, ptr, rc=status)
389+
@assertEqual(status, _SUCCESS, 'Failed to get REAL64 pointer by index for 3D field')
390+
391+
! Verify we got a pointer
392+
@assertTrue(associated(ptr), 'REAL64 pointer should be associated')
393+
nullify(ptr)
394+
395+
call ESMF_FieldDestroy(field1, _RC)
396+
call ESMF_FieldDestroy(field2, _RC)
397+
call ESMF_FieldBundleDestroy(bundle, _RC)
398+
399+
_UNUSED_DUMMY(this)
400+
end subroutine test_GetPointerByIndex3D_Real64
401+
402+
! Test getting REAL64 pointer by name for 2D field
403+
@Test(type=ESMF_TestMethod, npes=[1])
404+
subroutine test_GetPointerByName2D_Real64(this)
405+
class(ESMF_TestMethod), intent(inout) :: this
406+
407+
type(ESMF_FieldBundle) :: bundle
408+
type(ESMF_Field) :: field1, field2
409+
type(ESMF_Grid) :: grid
410+
real(REAL64), pointer :: ptr(:,:)
411+
integer :: rc, status
412+
type(ESMF_TypeKind_Flag), parameter :: typekind = ESMF_TYPEKIND_R8
413+
414+
! Create fields with names
415+
call ESMF_FieldGet(original, grid=grid, _RC)
416+
field1 = ESMF_FieldCreate(grid, typekind, _RC)
417+
call ESMF_FieldSet(field1, name='temperature_r8', _RC)
418+
field2 = ESMF_FieldCreate(grid, typekind, _RC)
419+
call ESMF_FieldSet(field2, name='pressure_r8', _RC)
420+
bundle = ESMF_FieldBundleCreate(fieldList=[field1, field2], _RC)
421+
422+
! Get REAL64 pointer by name
423+
call FieldBundleGetPointerToData(bundle, 'temperature_r8', ptr, rc=status)
424+
@assertEqual(status, _SUCCESS, 'Failed to get REAL64 pointer by name for 2D field')
425+
426+
! Verify we got a pointer
427+
@assertTrue(associated(ptr), 'REAL64 pointer by name should be associated')
428+
nullify(ptr)
429+
430+
call ESMF_FieldDestroy(field1, _RC)
431+
call ESMF_FieldDestroy(field2, _RC)
432+
call ESMF_FieldBundleDestroy(bundle, _RC)
433+
434+
_UNUSED_DUMMY(this)
435+
end subroutine test_GetPointerByName2D_Real64
436+
437+
! Test getting REAL64 pointer by name for 3D field
438+
@Test(type=ESMF_TestMethod, npes=[1])
439+
subroutine test_GetPointerByName3D_Real64(this)
440+
class(ESMF_TestMethod), intent(inout) :: this
441+
442+
type(ESMF_FieldBundle) :: bundle
443+
type(ESMF_Field) :: field1, field2
444+
type(ESMF_Grid) :: grid
445+
real(REAL64), pointer :: ptr(:,:,:)
446+
integer :: rc, status
447+
type(ESMF_TypeKind_Flag), parameter :: typekind = ESMF_TYPEKIND_R8
448+
449+
call ESMF_FieldGet(original, grid=grid, _RC)
450+
! Create actual 3D fields with names
451+
field1 = ESMF_FieldCreate(grid, typekind, ungriddedLBound=[1], ungriddedUBound=[2], _RC)
452+
call ESMF_FieldSet(field1, name='velocity_r8', _RC)
453+
field2 = ESMF_FieldCreate(grid, typekind, ungriddedLBound=[1], ungriddedUBound=[2], _RC)
454+
call ESMF_FieldSet(field2, name='density_r8', _RC)
455+
bundle = ESMF_FieldBundleCreate(fieldList=[field1, field2], _RC)
456+
457+
! Get REAL64 pointer by name
458+
call FieldBundleGetPointerToData(bundle, 'velocity_r8', ptr, rc=status)
459+
@assertEqual(status, _SUCCESS, 'Failed to get REAL64 pointer by name for 3D field')
460+
461+
! Verify we got a pointer
462+
@assertTrue(associated(ptr), 'REAL64 pointer by name should be associated')
463+
nullify(ptr)
464+
465+
call ESMF_FieldDestroy(field1, _RC)
466+
call ESMF_FieldDestroy(field2, _RC)
467+
call ESMF_FieldBundleDestroy(bundle, _RC)
468+
469+
_UNUSED_DUMMY(this)
470+
end subroutine test_GetPointerByName3D_Real64
471+
335472
end module Test_FieldBundleGetPointer

0 commit comments

Comments
 (0)