subroutine createFields(rc)
! Creates Fields and FieldBundles used by the tests in this module
integer, intent(out) :: rc
integer :: decompPTile(2,6)
integer :: decompPTileUnevenDEs(2,6)
type(ESMF_ArraySpec) :: arraySpec
type(ESMF_ArraySpec) :: arraySpec_w_ungridded
type(ESMF_Array) :: array1
type(ESMF_DELayout) :: delayout
real(ESMF_KIND_R8), pointer :: coordPtrX(:,:), coordPtrY(:,:)
integer :: u1, u2, i, j
real :: multiplier
!------------------------------------------------------------------------
! Set up 6-tile grid
!------------------------------------------------------------------------
! Decomposition for 8 PEs: Tiles 1 and 3 each have two DEs (along different
! dimensions); the other tiles each have one DE.
decompPTile(1,:) = [2,1,1,1,1,1]
decompPTile(2,:) = [1,1,2,1,1,1]
grid6tile = ESMF_GridCreateCubedSphere( &
tilesize = 4, &
regDecompPTile = decompPTile, &
staggerLocList = [ESMF_STAGGERLOC_CENTER], &
rc = rc)
if (rc /= ESMF_SUCCESS) return
!------------------------------------------------------------------------
! Create fields on the 6-tile grid and associated field bundle
!------------------------------------------------------------------------
call ESMF_ArraySpecSet(arraySpec, typekind=ESMF_TYPEKIND_R8, rank=2, rc=rc)
if (rc /= ESMF_SUCCESS) return
call ESMF_ArraySpecSet(arraySpec_w_ungridded, typekind=ESMF_TYPEKIND_R8, rank=4, rc=rc)
if (rc /= ESMF_SUCCESS) return
field1 = ESMF_FieldCreate(grid6tile, arraySpec, name="field1", rc=rc)
if (rc /= ESMF_SUCCESS) return
call ESMF_FieldFill(field1, dataFillScheme='sincos', member=1, rc=rc)
if (rc /= ESMF_SUCCESS) return
call ESMF_FieldGet(field1, farrayPtr=field1Data, rc=rc)
if (rc /= ESMF_SUCCESS) return
field1Read = ESMF_FieldCreate(grid6tile, arraySpec, name="field1", rc=rc)
if (rc /= ESMF_SUCCESS) return
call ESMF_FieldGet(field1Read, farrayPtr=field1ReadData, rc=rc)
if (rc /= ESMF_SUCCESS) return
field2 = ESMF_FieldCreate(grid6tile, arraySpec, name="field2", rc=rc)
if (rc /= ESMF_SUCCESS) return
call ESMF_FieldFill(field2, dataFillScheme='sincos', member=2, rc=rc)
if (rc /= ESMF_SUCCESS) return
call ESMF_FieldGet(field2, farrayPtr=field2Data, rc=rc)
if (rc /= ESMF_SUCCESS) return
field2Read = ESMF_FieldCreate(grid6tile, arraySpec, name="field2", rc=rc)
if (rc /= ESMF_SUCCESS) return
call ESMF_FieldGet(field2Read, farrayPtr=field2ReadData, rc=rc)
if (rc /= ESMF_SUCCESS) return
field3 = ESMF_FieldCreate(grid6tile, arraySpec, name="field3", rc=rc)
if (rc /= ESMF_SUCCESS) return
call ESMF_FieldFill(field3, dataFillScheme='sincos', member=3, rc=rc)
if (rc /= ESMF_SUCCESS) return
call ESMF_FieldGet(field3, farrayPtr=field3Data, rc=rc)
if (rc /= ESMF_SUCCESS) return
field3Read = ESMF_FieldCreate(grid6tile, arraySpec, name="field3", rc=rc)
if (rc /= ESMF_SUCCESS) return
call ESMF_FieldGet(field3Read, farrayPtr=field3ReadData, rc=rc)
if (rc /= ESMF_SUCCESS) return
field4d = ESMF_FieldCreate(grid6tile, arraySpec_w_ungridded, name="field4d", &
ungriddedLBound=[2,15], ungriddedUBound=[4,18], &
! 2nd and 4th dimensions are ungridded dimensions
gridToFieldMap=[1,3], &
rc=rc)
if (rc /= ESMF_SUCCESS) return
call ESMF_FieldGet(field4d, farrayPtr=field4dData, rc=rc)
if (rc /= ESMF_SUCCESS) return
call ESMF_GridGetCoord(grid6tile, coordDim=1, farrayPtr=coordPtrX, rc=rc)
if (rc /= ESMF_SUCCESS) return
call ESMF_GridGetCoord(grid6tile, coordDim=2, farrayPtr=coordPtrY, rc=rc)
do u1 = 2,4
do u2 = 15,18
do i = lbound(field4dData, 1), ubound(field4dData, 1)
do j = lbound(field4dData, 3), ubound(field4dData, 3)
multiplier = 5.**(u2-15)
field4dData(i,u1,j,u2) = u1*multiplier*(coordPtrX(i,j) - coordPtrY(i,j))
end do
end do
end do
end do
field4dRead = ESMF_FieldCreate(grid6tile, arraySpec_w_ungridded, name="field4d", &
ungriddedLBound=[2,15], ungriddedUBound=[4,18], &
! 2nd and 4th dimensions are ungridded dimensions
gridToFieldMap=[1,3], &
rc=rc)
if (rc /= ESMF_SUCCESS) return
call ESMF_FieldGet(field4dRead, farrayPtr=field4dReadData, rc=rc)
if (rc /= ESMF_SUCCESS) return
! Create a copy of field1 that uses the same array, so we can test writing
! the same array twice from a single call.
call ESMF_FieldGet(field1, array=array1, rc=rc)
if (rc /= ESMF_SUCCESS) return
field1Copy = ESMF_FieldCreate(grid6tile, array1, name="field1Copy", rc=rc)
if (rc /= ESMF_SUCCESS) return
call ESMF_FieldGet(field1Copy, farrayPtr=field1CopyData, rc=rc)
if (rc /= ESMF_SUCCESS) return
field1CopyRead = ESMF_FieldCreate(grid6tile, arraySpec, name="field1Copy", rc=rc)
if (rc /= ESMF_SUCCESS) return
call ESMF_FieldGet(field1CopyRead, farrayPtr=field1CopyReadData, rc=rc)
if (rc /= ESMF_SUCCESS) return
fieldBundle = ESMF_FieldBundleCreate(name="fb", rc=rc)
if (rc /= ESMF_SUCCESS) return
call ESMF_FieldBundleAdd(fieldBundle, [field1, field2, field1Copy, field4d], rc=rc)
if (rc /= ESMF_SUCCESS) return
fieldBundleRead = ESMF_FieldBundleCreate(name="fbRead", rc=rc)
if (rc /= ESMF_SUCCESS) return
call ESMF_FieldBundleAdd(fieldBundleRead, [field1Read, field2Read, field1CopyRead, field4dRead], rc=rc)
if (rc /= ESMF_SUCCESS) return
!------------------------------------------------------------------------
! Set up a 6-tile grid with an uneven distribution of DEs to PETs, and create fields
! on this grid
!------------------------------------------------------------------------
! Decomposition for 8 PEs but 16 DEs
!
! The number of DEs per tile is:
! Tile : 1 2 3 4 5 6
! # DEs: 2 1 6 1 3 3
!
! The DEs are scattered in a disorganized fashion across PETs. We have the following
! number of DEs on each PET:
! PET #: 0 1 2 3 4 5 6 7
! # DEs: 1 2 3 4 0 3 0 3
decompPTileUnevenDEs(1,:) = [2,1,3,1,1,3]
decompPTileUnevenDEs(2,:) = [1,1,2,1,3,1]
delayout = ESMF_DELayoutCreate(petMap=[3,2,5,5,1,3,2,1,7,3,0,7,2,7,3,5])
grid6tileUnevenDEs = ESMF_GridCreateCubedSphere( &
tilesize = 6, &
regDecompPTile = decompPTileUnevenDEs, &
delayout = delayout, &
staggerLocList = [ESMF_STAGGERLOC_CENTER], &
rc = rc)
if (rc /= ESMF_SUCCESS) return
call ESMF_GridGet(grid6tileUnevenDEs, localDECount=grid6tileUnevenDEsLdeCount, rc=rc)
if (rc /= ESMF_SUCCESS) return
field1UnevenDEs = ESMF_FieldCreate(grid6tileUnevenDEs, arraySpec, name="field1UnevenDEs", rc=rc)
if (rc /= ESMF_SUCCESS) return
call ESMF_FieldFill(field1UnevenDEs, dataFillScheme='sincos', member=1, rc=rc)
if (rc /= ESMF_SUCCESS) return
! Note that we can't get farrayPtr here because we'll need to do that in a loop over DEs
field1UnevenDEsRead = ESMF_FieldCreate(grid6tileUnevenDEs, arraySpec, name="field1UnevenDEs", rc=rc)
if (rc /= ESMF_SUCCESS) return
! Note that we can't get farrayPtr here because we'll need to do that in a loop over DEs
field4dUnevenDEs = ESMF_FieldCreate(grid6tileUnevenDEs, arraySpec_w_ungridded, name="field4dUnevenDEs", &
ungriddedLBound=[2,15], ungriddedUBound=[4,18], &
! 2nd and 4th dimensions are ungridded dimensions
gridToFieldMap=[1,3], &
rc=rc)
if (rc /= ESMF_SUCCESS) return
do lde = 0, grid6tileUnevenDEsLdeCount-1
call ESMF_FieldGet(field4dUnevenDEs, localDe=lde, farrayPtr=field4dUnevenDEsData, rc=rc)
if (rc /= ESMF_SUCCESS) return
call ESMF_GridGetCoord(grid6tileUnevenDEs, coordDim=1, localDe=lde, farrayPtr=coordPtrX, rc=rc)
if (rc /= ESMF_SUCCESS) return
call ESMF_GridGetCoord(grid6tileUnevenDEs, coordDim=2, localDe=lde, farrayPtr=coordPtrY, rc=rc)
if (rc /= ESMF_SUCCESS) return
do u1 = 2,4
do u2 = 15,18
do i = lbound(field4dUnevenDEsData, 1), ubound(field4dUnevenDEsData, 1)
do j = lbound(field4dUnevenDEsData, 3), ubound(field4dUnevenDEsData, 3)
multiplier = 5.**(u2-15)
field4dUnevenDEsData(i,u1,j,u2) = u1*multiplier*(coordPtrX(i,j) - coordPtrY(i,j))
end do
end do
end do
end do
end do
field4dUnevenDEsRead = ESMF_FieldCreate(grid6tileUnevenDEs, arraySpec_w_ungridded, name="field4dUnevenDEs", &
ungriddedLBound=[2,15], ungriddedUBound=[4,18], &
! 2nd and 4th dimensions are ungridded dimensions
gridToFieldMap=[1,3], &
rc=rc)
if (rc /= ESMF_SUCCESS) return
end subroutine createFields