program FieldRedistEx
!-------------------------------------------------------------------------
!ESMF_MULTI_PROC_EXAMPLE String used by test script to count examples.
!==============================================================================
!
! !PROGRAM: ESMF_FieldRedistEx - Field Redistribution
!
! !DESCRIPTION:
!
! This program shows examples of Field interfaces for redistribution of data.
!-----------------------------------------------------------------------------
#include "ESMF.h"
#include "ESMF_Macros.inc"
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_FieldRedistEx"
! ESMF Framework module
use ESMF
use ESMF_TestMod
implicit none
!------------------------------------------------------------------------------
! The following line turns the CVS identifier string into a printable variable.
character(*), parameter :: version = &
'$Id$'
!------------------------------------------------------------------------------
! Local variables
integer :: rc, finalrc, result
type(ESMF_Field) :: srcField, dstField
type(ESMF_Field) :: srcFieldA, dstFieldA
type(ESMF_Grid) :: grid
type(ESMF_DistGrid) :: distgrid
type(ESMF_VM) :: vm
type(ESMF_RouteHandle) :: routehandle
type(ESMF_Array) :: srcArray, dstArray
type(ESMF_ArraySpec) :: arrayspec
integer :: localrc, localPet, i
integer, pointer :: fptr(:)
integer, pointer :: srcfptr(:), dstfptr(:)
type(ESMF_Mesh) :: mesh
integer, pointer :: nodeIds(:),nodeOwners(:)
real(ESMF_KIND_R8), pointer :: nodeCoords(:)
integer :: numNodes
integer :: numElems
integer, pointer :: elemIds(:),elemTypes(:),elemConn(:)
character(ESMF_MAXSTR) :: testname
character(ESMF_MAXSTR) :: failMsg
!-------------------------------------------------------------------------
!-------------------------------------------------------------------------
write(failMsg, *) "Example failure"
write(testname, *) "Example ESMF_FieldRedistEx"
! ------------------------------------------------------------------------------
! ------------------------------------------------------------------------------
rc = ESMF_SUCCESS
localrc = ESMF_SUCCESS
finalrc = ESMF_SUCCESS
!------------------------------------------------------------------------------
call ESMF_Initialize(defaultlogfilename="FieldRedistEx.Log", &
logkindflag=ESMF_LOGKIND_MULTI, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
if (.not. ESMF_TestMinPETs(4, ESMF_SRCLINE)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------------
!BOE
! \subsubsection{Redistribute data from source Field to destination Field}
! \label{sec:field:usage:redist_1dptr}
!
! User can use {\tt ESMF\_FieldRedist} interface to redistribute data from
! source Field to destination Field. This interface is overloaded by type and kind;
! In the version of {\tt ESMF\_FieldRedist} without factor argument, a default value
! of 1 is used.
!
! \begin{sloppypar}
! In this example, we first create two 1D Fields, a source Field and a destination
! Field. Then we use {\tt ESMF\_FieldRedist} to
! redistribute data from source Field to destination Field.
! \end{sloppypar}
!EOE
!BOC
! Get current VM and pet number
call ESMF_VMGetCurrent(vm, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_VMGet(vm, localPet=localPet, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
! create grid
distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/16/), &
regDecomp=(/4/), &
rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
grid = ESMF_GridCreate(distgrid=distgrid, &
name="grid", rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
! create srcField
! +--------+--------+--------+--------+
! 0 1 2 3 ! value
! 1 4 8 12 16 ! bounds
srcField = ESMF_FieldCreate(grid, typekind=ESMF_TYPEKIND_I4, &
indexflag=ESMF_INDEX_DELOCAL, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_FieldGet(srcField, farrayPtr=srcfptr, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
srcfptr(:) = localPet
! create dstField
! +--------+--------+--------+--------+
! 0 0 0 0 ! value
! 1 4 8 12 16 ! bounds
dstField = ESMF_FieldCreate(grid, typekind=ESMF_TYPEKIND_I4, &
indexflag=ESMF_INDEX_DELOCAL, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_FieldGet(dstField, farrayPtr=dstfptr, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
dstfptr(:) = 0
! perform redist
! 1. setup routehandle from source Field to destination Field
call ESMF_FieldRedistStore(srcField, dstField, routehandle, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
! 2. use precomputed routehandle to redistribute data
call ESMF_FieldRedist(srcfield, dstField, routehandle, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
! verify redist
call ESMF_FieldGet(dstField, localDe=0, farrayPtr=fptr, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
! Verify that the redistributed data in dstField is correct.
! Before the redist op, the dst Field contains all 0.
! The redist op reset the values to the PE value, verify this is the case.
do i = lbound(fptr, 1), ubound(fptr, 1)
if(fptr(i) .ne. localPet) localrc = ESMF_FAILURE
enddo
if (localrc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!EOC
! destroy all objects created in this example to prevent memory leak
call ESMF_FieldDestroy(srcField, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_FieldDestroy(dstField, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!BOE
! Field redistribution can also be performed between different Field pairs that
! match the original Fields in {\em type}, {\em kind}, and memory layout of the
! {\em gridded} dimensions. However, the size, number, and index order of
! {\em ungridded} dimensions may be different. See section \ref{RH:Reusability}
! for a more detailed discussion of RouteHandle reusability.
!EOE
!BOC
call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_I4, rank=2, rc=rc)
!EOC
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!BOE
! Create two fields with ungridded dimensions using the Grid created previously.
! The new Field pair has matching number of elements. The ungridded dimension
! is mapped to the first dimension of either Field.
!EOE
!BOC
srcFieldA = ESMF_FieldCreate(grid, arrayspec, gridToFieldMap=(/2/), &
ungriddedLBound=(/1/), ungriddedUBound=(/10/), rc=rc)
!EOC
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!BOC
dstFieldA = ESMF_FieldCreate(grid, arrayspec, gridToFieldMap=(/2/), &
ungriddedLBound=(/1/), ungriddedUBound=(/10/), rc=rc)
!EOC
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!BOE
! Using the previously computed routehandle, the Fields can be redistributed.
!EOE
!BOC
call ESMF_FieldRedist(srcfieldA, dstFieldA, routehandle, rc=rc)
!EOC
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!BOC
call ESMF_FieldRedistRelease(routehandle, rc=rc)
!EOC
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_FieldDestroy(srcFieldA, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_FieldDestroy(dstFieldA, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_GridDestroy(grid, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------------
!BOE
! \subsubsection{FieldRedist as a form of scatter involving arbitrary distribution}
! \label{sec:field:usage:redist_scattering}
!
! User can use {\tt ESMF\_FieldRedist} interface to redistribute data from
! source Field to destination Field, where the destination Field is built on
! an arbitrarily distributed structure, e.g. {\tt ESMF\_Mesh}. The underlying mechanism is explained
! in section \ref{Array:ScatterGatherRevisited}.
!
! In this example, we will create 2 one dimensional Fields, the src Field has a regular decomposition
! and holds all its data on a single PET, in this case PET 0. The destination Field is built on a Mesh
! which is itself built on an arbitrarily distributed distgrid. Then we use {\tt ESMF\_FieldRedist} to
! redistribute data from source Field to destination Field, similar to a traditional scatter operation.
!
! The src Field only has data on PET 0 where it is sequentially initialized, i.e. 1,2,3...This data
! will be redistributed (or scattered) from PET 0 to the destination Field arbitrarily distributed on
! all the PETs.
!EOE
!BOC
! a one dimensional grid whose elements are all located on PET 0
distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/9/), &
regDecomp=(/1/), &
rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
grid = ESMF_GridCreate(distgrid=distgrid, &
indexflag=ESMF_INDEX_DELOCAL, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
srcField = ESMF_FieldCreate(grid, typekind=ESMF_TYPEKIND_I4, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
! initialize the source data
if (localPet == 0) then
call ESMF_FieldGet(srcField, farrayPtr=srcfptr, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
do i = 1, 9
srcfptr(i) = i
enddo
endif
!EOC
! Setup mesh data depending on PET
if (localPet .eq. 0) then
! Fill in node data
numNodes=4
!! node ids
allocate(nodeIds(numNodes))
nodeIds=(/1,2,4,5/)
!! node Coords
allocate(nodeCoords(numNodes*2))
nodeCoords=(/0.0,0.0, &
1.0,0.0, &
0.0,1.0, &
1.0,1.0/)
!! node owners
allocate(nodeOwners(numNodes))
nodeOwners=(/0,0,0,0/) ! everything on proc 0
! Fill in elem data
numElems=1
!! elem ids
allocate(elemIds(numElems))
elemIds=(/1/)
!! elem type
allocate(elemTypes(numElems))
elemTypes=ESMF_MESHELEMTYPE_QUAD
!! elem conn
allocate(elemConn(numElems*4))
elemConn=(/1,2,4,3/)
else if (localPet .eq. 1) then
! Fill in node data
numNodes=4
!! node ids
allocate(nodeIds(numNodes))
nodeIds=(/2,3,5,6/)
!! node Coords
allocate(nodeCoords(numNodes*2))
nodeCoords=(/1.0,0.0, &
2.0,0.0, &
1.0,1.0, &
2.0,1.0/)
!! node owners
allocate(nodeOwners(numNodes))
nodeOwners=(/0,1,0,1/)
! Fill in elem data
numElems=1
!! elem ids
allocate(elemIds(numElems))
elemIds=(/2/)
!! elem type
allocate(elemTypes(numElems))
elemTypes=ESMF_MESHELEMTYPE_QUAD
!! elem conn
allocate(elemConn(numElems*4))
elemConn=(/1,2,4,3/)
else if (localPet .eq. 2) then
! Fill in node data
numNodes=4
!! node ids
allocate(nodeIds(numNodes))
nodeIds=(/4,5,7,8/)
!! node Coords
allocate(nodeCoords(numNodes*2))
nodeCoords=(/0.0,1.0, &
1.0,1.0, &
0.0,2.0, &
1.0,2.0/)
!! node owners
allocate(nodeOwners(numNodes))
nodeOwners=(/0,0,2,2/)
! Fill in elem data
numElems=1
!! elem ids
allocate(elemIds(numElems))
elemIds=(/3/)
!! elem type
allocate(elemTypes(numElems))
elemTypes=ESMF_MESHELEMTYPE_QUAD
!! elem conn
allocate(elemConn(numElems*4))
elemConn=(/1,2,4,3/)
else
! Fill in node data
numNodes=4
!! node ids
allocate(nodeIds(numNodes))
nodeIds=(/5,6,8,9/)
!! node Coords
allocate(nodeCoords(numNodes*2))
nodeCoords=(/1.0,1.0, &
2.0,1.0, &
1.0,2.0, &
2.0,2.0/)
!! node owners
allocate(nodeOwners(numNodes))
nodeOwners=(/0,1,2,3/)
! Fill in elem data
numElems=1
!! elem ids
allocate(elemIds(numElems))
elemIds=(/4/)
!! elem type
allocate(elemTypes(numElems))
elemTypes=ESMF_MESHELEMTYPE_QUAD
!! elem conn
allocate(elemConn(numElems*4))
elemConn=(/1,2,4,3/)
endif
!BOE
! For more information on Mesh creation, user can refer to Mesh examples section or Field creation
! on Mesh example for more details.
!EOE
!BOC
! Create Mesh structure
mesh=ESMF_MeshCreate(parametricDim=2,spatialDim=2, &
nodeIds=nodeIds, nodeCoords=nodeCoords, &
nodeOwners=nodeOwners, elementIds=elemIds,&
elementTypes=elemTypes, elementConn=elemConn, &
rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!EOC
! deallocate node data
deallocate(nodeIds)
deallocate(nodeCoords)
deallocate(nodeOwners)
! deallocate elem data
deallocate(elemIds)
deallocate(elemTypes)
deallocate(elemConn)
!BOE
! Create the destination Field on the Mesh that is arbitrarily distributed on
! all the PETs.
!EOE
!BOC
dstField = ESMF_FieldCreate(mesh, typekind=ESMF_TYPEKIND_I4, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!EOC
!BOE
! Perform the redistribution from source Field to destination Field.
!EOE
!BOC
call ESMF_FieldRedistStore(srcField, dstField, &
routehandle=routehandle, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_FieldRedist(srcField, dstField, routehandle=routehandle, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!EOC
!BOE
! We can now verify that the sequentially initialized source data is scattered
! on to the destination Field. The data has been scattered onto the destination
! Field with the following distribution.
!\begin{verbatim}
!
! 4 elements on PET 0: 1 2 4 5
! 2 elements on PET 1: 3 6
! 2 elements on PET 2: 7 8
! 1 element on PET 3: 9
!
!\end{verbatim}
! Because the redistribution is index based, the elements also corresponds to the
! index space of Mesh in the destination Field.
!EOE
!BOC
call ESMF_FieldGet(dstField, farrayPtr=dstfptr, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!EOC
!BOE
! The scatter operation is successful. Since the routehandle computed with
! {\tt ESMF\_FieldRedistStore} can be reused, user can use the same routehandle
! to scatter multiple source Fields from a single PET to multiple destination
! Fields distributed on all PETs. The {\tt gathering} operation is just the
! opposite of the demonstrated {\tt scattering} operation, where a user would
! redist from a source Field distributed on multiple PETs to a destination Field
! that only has data storage on a single PET.
!
! Now it's time to release all the resources.
!EOE
!BOC
call ESMF_FieldRedistRelease(routehandle=routehandle, rc=rc)
!EOC
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------------
!BOE
! \subsubsection{FieldRedist as a form of gather involving arbitrary distribution}
! \label{sec:field:usage:redist_gathering}
!
! Similarly, one can use the same approach to gather the data from an arbitrary distribution
! to a non-arbitrary distribution. This concept is demonstrated by using the previous Fields but
! the data operation is reversed. This time data is gathered from the Field built on the mesh to the Field
! that has only data allocation on rootPet.
!
!EOE
!BOE
! First a FieldRedist routehandle is created from the Field built on Mesh to the Field
! that has only data allocation on rootPet.
!EOE
!BOC
call ESMF_FieldRedistStore(dstField, srcField, routehandle=routehandle, &
rc=rc)
!EOC
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!BOE
! Perform FieldRedist, this will gather the data points from the Field built on mesh to
! the data pointer on the rootPet (default to 0) stored in the srcField.
!EOE
!BOC
call ESMF_FieldRedist(dstField, srcField, routehandle=routehandle, rc=rc)
!EOC
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!BOE
! Release the routehandle used for the gather operation.
!EOE
!BOC
call ESMF_FieldRedistRelease(routehandle=routehandle, rc=rc)
!EOC
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_FieldDestroy(srcField, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_FieldDestroy(dstField, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_MeshDestroy(mesh, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_DistGridDestroy(distgrid, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
! IMPORTANT: ESMF_STest() prints the PASS string and the # of processors in the log
! file that the scripts grep for.
call ESMF_STest((finalrc.eq.ESMF_SUCCESS), testname, failMsg, result, ESMF_SRCLINE)
call ESMF_Finalize(rc=rc)
if(rc .ne. ESMF_SUCCESS) finalrc = ESMF_FAILURE
if (finalrc.EQ.ESMF_SUCCESS) then
print *, "PASS: ESMF_FieldRedistEx.F90"
else
print *, "FAIL: ESMF_FieldRedistEx.F90"
end if
end program FieldRedistEx