program ESMF_ArrayScatterUTest
!------------------------------------------------------------------------------
#include "ESMF_Macros.inc"
!==============================================================================
!BOP
! !PROGRAM: ESMF_ArrayScatterUTest - This unit test file tests ArrayScatter()
! !DESCRIPTION:
!
! The code in this file drives Fortran ArrayScatter unit tests.
! The companion file ESMF\_Array.F90 contains the definitions for the
! Array methods.
!
!-----------------------------------------------------------------------------
! !USES:
use ESMF_TestMod ! test methods
use ESMF
implicit none
!------------------------------------------------------------------------------
! The following line turns the CVS identifier string into a printable variable.
character(*), parameter :: version = &
'$Id$'
!------------------------------------------------------------------------------
! cumulative result: count failures; no failures equals "all pass"
integer :: result = 0
! individual test result code
integer :: rc
! individual test failure message
character(ESMF_MAXSTR) :: failMsg
character(ESMF_MAXSTR) :: name
!LOCAL VARIABLES:
real(ESMF_KIND_R8), parameter :: min_R8 = 1.d-10
real(ESMF_KIND_R4), parameter :: min_R4 = 1.e-4
type(ESMF_VM):: vm
integer:: petCount, localPet, i, j
type(ESMF_ArraySpec) :: arrayspec
type(ESMF_DistGrid) :: distgrid
type(ESMF_Array) :: array
real(ESMF_KIND_R8), pointer :: farrayPtr(:,:) ! matching Fortran array pointer
real(ESMF_KIND_R8), allocatable :: srcfarray(:,:)
real(ESMF_KIND_R8), allocatable :: srcfarray_save(:,:)
real(ESMF_KIND_R8):: value
real(ESMF_KIND_R4), pointer :: farrayPtr_R4(:,:) ! matching Fortran array pointer
real(ESMF_KIND_R4), allocatable :: srcfarray_R4(:,:)
real(ESMF_KIND_R4), allocatable :: srcfarray_R4_save(:,:)
real(ESMF_KIND_R4):: value_R4
#ifdef ESMF_TESTEXHAUSTIVE
integer:: k, kk, ii, jj, dimExtent1, dimExtent2
integer, allocatable:: indexList1(:), indexList2(:)
real(ESMF_KIND_R8), pointer :: farrayPtr3d(:,:,:) ! matching Fortran array pointer
real(ESMF_KIND_R8), allocatable :: srcfarray3d(:,:,:)
real(ESMF_KIND_R8), allocatable :: srcfarray3d_save(:,:,:)
integer:: exclusiveLBound(2,1), exclusiveUBound(2,1)
#endif
!-------------------------------------------------------------------------------
! The unit tests are divided into Sanity and Exhaustive. The Sanity tests are
! always run. When the environment variable, EXHAUSTIVE, is set to ON then
! the EXHAUSTIVE and sanity tests both run. If the EXHAUSTIVE variable is set
! to OFF, then only the sanity unit tests.
! Special strings (Non-exhaustive and exhaustive) have been
! added to allow a script to count the number and types of unit tests.
!-------------------------------------------------------------------------------
!------------------------------------------------------------------------
call ESMF_TestStart(ESMF_SRCLINE, rc=rc) ! calls ESMF_Initialize() internally
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
! preparations
call ESMF_VMGetGlobal(vm, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------
! this unit test requires to be run on exactly 4 PETs
if (petCount /= 4) goto 10
print *, min_R4, min_R8
!------------------------------------------------------------------------
! preparations
call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R8, rank=2, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/15,23/), &
regDecomp=(/2,2/), rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!call ESMF_ArrayPrint(array)
call ESMF_ArrayGet(array, farrayPtr=farrayPtr, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
farrayPtr = real(localPet,ESMF_KIND_R8) ! initialize each DE-local data chunk of Array
!print *, "farrayPtr:", farrayPtr
! prepare srcfarray on all PETs -> serves as ref. in comparison after scatter
allocate(srcfarray(1:15, 1:23))
allocate(srcfarray_save(1:15, 1:23))
do j=1, 23
do i=1, 15
srcfarray(i,j) = 123._ESMF_KIND_R8*sin(real(i,ESMF_KIND_R8)) + &
321._ESMF_KIND_R8*cos(real(j,ESMF_KIND_R8))
srcfarray_save(i,j) = srcfarray(i,j)
enddo
enddo
!print *, "srcfarray:", srcfarray
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "2D ESMF_TYPEKIND_R8 ArrayScatter() w/ incompatible Fortran Array (typekind) Test"
write(failMsg, *) "Did return ESMF_SUCCESS"
allocate (srcfarray_R4(1,1))
call ESMF_ArrayScatter(array, srcfarray_R4, rootPet=0, rc=rc)
call ESMF_Test((rc.ne.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
deallocate (srcfarray_R4)
#ifdef ESMF_TESTEXHAUSTIVE
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
write(name, *) "2D ESMF_TYPEKIND_R8 ArrayScatter() w/ incompatible Fortran Array (rank) Test"
write(failMsg, *) "Did return ESMF_SUCCESS"
allocate (srcfarray3d(1,1,1))
call ESMF_ArrayScatter(array, srcfarray3d, rootPet=0, rc=rc)
call ESMF_Test((rc.ne.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
deallocate (srcfarray3d)
#endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "2D ESMF_TYPEKIND_R8 ArrayScatter() Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayScatter(array, srcfarray, rootPet=0, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Verify srcfarray data after scatter
write(name, *) "Verifying srcfarray data after 2D ESMF_TYPEKIND_R8 ArrayScatter() Test"
write(failMsg, *) "Source data was modified."
rc = ESMF_SUCCESS
do j=1, 23
do i=1, 15
value = 123._ESMF_KIND_R8*sin(real(i,ESMF_KIND_R8)) + &
321._ESMF_KIND_R8*cos(real(j,ESMF_KIND_R8))
value = srcfarray(i,j) - srcfarray_save(i,j)
if (abs(value) > min_R8) then
print *, "Found mismatch value", i, j, value
rc = ESMF_FAILURE
endif
enddo
enddo
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Verify Array data after scatter
write(name, *) "Verifying destination Array data after 2D ESMF_TYPEKIND_R8 ArrayScatter() Test"
write(failMsg, *) "Array data wrong."
rc = ESMF_SUCCESS
do j=lbound(farrayPtr,2), ubound(farrayPtr,2)
do i=lbound(farrayPtr,1), ubound(farrayPtr,1)
if (abs(farrayPtr(i,j) - srcfarray(i,j)) > min_R8) then
print *, "Found mismatch value", i, j, &
abs(farrayPtr(i,j) - srcfarray(i,j))
rc = ESMF_FAILURE
endif
enddo
enddo
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
! cleanup
call ESMF_ArrayDestroy(array, 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)
deallocate(srcfarray)
deallocate(srcfarray_save)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!------------------------------------------------------------------------
! preparations for same test as above but omit farray on PETs not root
call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R8, rank=2, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/15,23/), &
regDecomp=(/2,2/), rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!call ESMF_ArrayPrint(array)
call ESMF_ArrayGet(array, farrayPtr=farrayPtr, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
farrayPtr = real(localPet,ESMF_KIND_R8) ! initialize each DE-local data chunk of Array
!print *, "farrayPtr:", farrayPtr
! prepare srcfarray on all PETs -> serves as ref. in comparison after scatter
allocate(srcfarray(1:15, 1:23))
allocate(srcfarray_save(1:15, 1:23))
do j=1, 23
do i=1, 15
srcfarray(i,j) = 123._ESMF_KIND_R8*sin(real(i,ESMF_KIND_R8)) + &
321._ESMF_KIND_R8*cos(real(j,ESMF_KIND_R8))
srcfarray_save(i,j) = srcfarray(i,j)
enddo
enddo
!print *, "srcfarray:", srcfarray
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "2D ESMF_TYPEKIND_R8 ArrayScatter() with omitted srcfarray Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
if (localPet==0) then
call ESMF_ArrayScatter(array, farray=srcfarray, rootPet=0, rc=rc)
else
call ESMF_ArrayScatter(array, rootPet=0, rc=rc)
endif
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Verify srcfarray data after scatter
write(name, *) "Verifying srcfarray data after 2D ESMF_TYPEKIND_R8 ArrayScatter() ",&
"with omitted srcfarray Test"
write(failMsg, *) "Source data was modified."
rc = ESMF_SUCCESS
do j=1, 23
do i=1, 15
value = srcfarray(i,j) - srcfarray_save(i,j)
if (abs(value) > min_R8) then
print *, "Found mismatch value", i, j, value
rc = ESMF_FAILURE
endif
enddo
enddo
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Verify Array data after scatter
write(name, *) "Verifying destination Array data after 2D ESMF_TYPEKIND_R8 ",&
"ArrayScatter() with omitted srcfarray Test"
write(failMsg, *) "Array data wrong."
rc = ESMF_SUCCESS
do j=lbound(farrayPtr,2), ubound(farrayPtr,2)
do i=lbound(farrayPtr,1), ubound(farrayPtr,1)
if (abs(farrayPtr(i,j) - srcfarray(i,j)) > min_R8) then
print *, "Found mismatch value", i, j, &
abs(farrayPtr(i,j) - srcfarray(i,j))
rc = ESMF_FAILURE
endif
enddo
enddo
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
! cleanup
call ESMF_ArrayDestroy(array, 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)
deallocate(srcfarray)
deallocate(srcfarray_save)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!------------------------------------------------------------------------
! preparations for same test as above but with ESMF_TYPEKIND_R4
call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R4, rank=2, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/15,23/), &
regDecomp=(/2,2/), rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!call ESMF_ArrayPrint(array)
call ESMF_ArrayGet(array, farrayPtr=farrayPtr_R4, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
farrayPtr_R4 = real(localPet,ESMF_KIND_R4) ! initialize each DE-local data chunk of Array
!print *, "farrayPtr_R4:", farrayPtr_R4
! prepare srcfarray_R4 on all PETs -> serves as ref. in comparison after scatter
allocate(srcfarray_R4(1:15, 1:23))
allocate(srcfarray_R4_save(1:15, 1:23))
do j=1, 23
do i=1, 15
srcfarray_R4(i,j) = 123._ESMF_KIND_R4*sin(real(i,ESMF_KIND_R4)) + &
321._ESMF_KIND_R4*cos(real(j,ESMF_KIND_R4))
srcfarray_R4_save(i,j) = srcfarray_R4(i,j)
enddo
enddo
!print *, "srcfarray_R4:", srcfarray_R4
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "2D ESMF_TYPEKIND_R4 ArrayScatter() Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayScatter(array, srcfarray_R4, rootPet=0, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Verify srcfarray_R4 data after scatter
write(name, *) "Verifying srcfarray_R4 data after 2D ESMF_TYPEKIND_R4 ArrayScatter() Test"
write(failMsg, *) "Source data was modified."
rc = ESMF_SUCCESS
do j=1, 23
do i=1, 15
value_R4 = srcfarray_R4(i,j) - srcfarray_R4_save(i,j)
if (abs(value_R4) > min_R4) then
print *, "Found mismatch value", i, j, value_R4
rc = ESMF_FAILURE
endif
enddo
enddo
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Verify Array data after scatter
write(name, *) "Verifying destination Array data after 2D ESMF_TYPEKIND_R4 ArrayScatter() Test"
write(failMsg, *) "Array data wrong."
rc = ESMF_SUCCESS
do j=lbound(farrayPtr_R4,2), ubound(farrayPtr_R4,2)
do i=lbound(farrayPtr_R4,1), ubound(farrayPtr_R4,1)
if (abs(farrayPtr_R4(i,j) - srcfarray_R4(i,j)) > min_R4) then
print *, "Found mismatch value", i, j, &
abs(farrayPtr_R4(i,j) - srcfarray_R4(i,j))
rc = ESMF_FAILURE
endif
enddo
enddo
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
! cleanup
call ESMF_ArrayDestroy(array, 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)
deallocate(srcfarray_R4)
deallocate(srcfarray_R4_save)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!------------------------------------------------------------------------
! preparations for same test as above but with a DistGrid that has less
! elements in the first dimension than DEs requested in the regDecomp argument.
! -> there will be DEs not associated with DistGrid elements, namely DE 1 and
! DE 3.
call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R8, rank=2, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/1,23/), &
regDecomp=(/2,2/), rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!call ESMF_ArrayPrint(array)
call ESMF_ArrayGet(array, farrayPtr=farrayPtr, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
farrayPtr = real(localPet,ESMF_KIND_R8) ! initialize each DE-local data chunk of Array
!print *, "farrayPtr:", farrayPtr
! prepare srcfarray on all PETs -> serves as ref. in comparison after scatter
allocate(srcfarray(1:1, 1:23))
allocate(srcfarray_save(1:1, 1:23))
do j=1, 23
do i=1, 1
srcfarray(i,j) = 123._ESMF_KIND_R8*sin(real(i,ESMF_KIND_R8)) + &
321._ESMF_KIND_R8*cos(real(j,ESMF_KIND_R8))
srcfarray_save(i,j) = srcfarray(i,j)
enddo
enddo
!print *, "srcfarray:", srcfarray
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "2D ESMF_TYPEKIND_R8 ArrayScatter() with unassociated DEs Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayScatter(array, srcfarray, rootPet=0, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Verify srcfarray data after scatter
write(failMsg, *) "Source data was modified."
write(name, *) "Verifying srcfarray data after 2D ArrayScatter() Test"
rc = ESMF_SUCCESS
do j=1, 23
do i=1, 1
value = 123._ESMF_KIND_R8*sin(real(i,ESMF_KIND_R8)) + &
321._ESMF_KIND_R8*cos(real(j,ESMF_KIND_R8))
value = srcfarray(i,j) - srcfarray_save(i,j)
if (abs(value) > min_R8) then
print *, "Found mismatch value", i, j, value
rc = ESMF_FAILURE
endif
enddo
enddo
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Verify Array data after scatter
write(failMsg, *) "Array data wrong."
write(name, *) "Verifying destination Array data after 2D ArrayScatter() with unassociated DEs Test"
rc = ESMF_SUCCESS
do j=lbound(farrayPtr,2), ubound(farrayPtr,2)
do i=lbound(farrayPtr,1), ubound(farrayPtr,1)
if (abs(farrayPtr(i,j) - srcfarray(i,j)) > min_R8) then
print *, "Found mismatch value", i, j, &
abs(farrayPtr(i,j) - srcfarray(i,j))
rc = ESMF_FAILURE
endif
enddo
enddo
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
! cleanup
call ESMF_ArrayDestroy(array, 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)
deallocate(srcfarray)
deallocate(srcfarray_save)
#ifdef ESMF_TESTEXHAUSTIVE
!------------------------------------------------------------------------
! preparations for testing ArrayScatter() for a
! 2D+1 Array, i.e. an Array with 3D data rank but 2D decomposition
call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R8, rank=3, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/15,23/), &
regDecomp=(/2,2/), rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, undistLBound=(/-5/), undistUBound=(/4/), &
rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!call ESMF_ArrayPrint(array)
call ESMF_ArrayGet(array, farrayPtr=farrayPtr3d, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
farrayPtr3d = real(localPet,ESMF_KIND_R8) ! initialize each DE-local data chunk of Array
!print *, "farrayPtr3d:", farrayPtr3d
! prepare srcfarray on all PETs -> serves as ref. in comparison after scatter
allocate(srcfarray3d(1:15, 1:23, 10))
allocate(srcfarray3d_save(1:15, 1:23, 10))
do k=lbound(srcfarray3d,3), ubound(srcfarray3d,3)
do j=lbound(srcfarray3d,2), ubound(srcfarray3d,2)
do i=lbound(srcfarray3d,1), ubound(srcfarray3d,1)
srcfarray3d(i,j,k) = 123._ESMF_KIND_R8*sin(real(i,ESMF_KIND_R8)) + &
321._ESMF_KIND_R8*cos(real(j,ESMF_KIND_R8)) + &
20._ESMF_KIND_R8*real(k,ESMF_KIND_R8)
srcfarray3d_save(i,j,k) = srcfarray3d(i,j,k)
enddo
enddo
enddo
!print *, "srcfarray3d:", srcfarray3d
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "2D+1 ArrayScatter() Test"
call ESMF_ArrayScatter(array, srcfarray3d, rootPet=0, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Verify srcfarray3d data after scatter
write(failMsg, *) "Source data was modified."
write(name, *) "Verifying srcfarray3d data after 2D+1 ArrayScatter() Test"
rc = ESMF_SUCCESS
do k=lbound(srcfarray3d,3), ubound(srcfarray3d,3)
do j=lbound(srcfarray3d,2), ubound(srcfarray3d,2)
do i=lbound(srcfarray3d,1), ubound(srcfarray3d,1)
value = 123._ESMF_KIND_R8*sin(real(i,ESMF_KIND_R8)) + &
321._ESMF_KIND_R8*cos(real(j,ESMF_KIND_R8)) + &
20._ESMF_KIND_R8*real(k,ESMF_KIND_R8)
value = srcfarray3d(i,j,k) - srcfarray3d_save(i,j,k)
if (abs(value) > min_R8) then
print *, "Found mismatch value", i, j, k, value
rc = ESMF_FAILURE
endif
enddo
enddo
enddo
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Verify Array data after scatter
write(failMsg, *) "Array data wrong."
write(name, *) "Verifying destination Array data after 2D+1 ArrayScatter() Test"
rc = ESMF_SUCCESS
do k=lbound(farrayPtr3d,3), ubound(farrayPtr3d,3)
kk = k - lbound(farrayPtr3d,3) + lbound(srcfarray3d,3)
do j=lbound(farrayPtr3d,2), ubound(farrayPtr3d,2)
do i=lbound(farrayPtr3d,1), ubound(farrayPtr3d,1)
if (abs(farrayPtr3d(i,j,k) - srcfarray3d(i,j,kk)) > min_R8) then
print *, "Found mismatch value", i, j, k, &
abs(farrayPtr3d(i,j,k) - srcfarray3d(i,j,kk))
rc = ESMF_FAILURE
endif
enddo
enddo
enddo
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
! cleanup
call ESMF_ArrayDestroy(array, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
deallocate(srcfarray3d)
deallocate(srcfarray3d_save)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!------------------------------------------------------------------------
! preparations for testing ArrayScatter() for a 2D+1 Array with
! non-contiguous exclusive region
call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R8, rank=3, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, &
totalLWidth=(/2,3/), totalUWidth=(/3,4/), indexflag=ESMF_INDEX_GLOBAL, &
undistLBound=(/-5/), undistUBound=(/4/), rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!call ESMF_ArrayPrint(array)
call ESMF_ArrayGet(array, farrayPtr=farrayPtr3d, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
farrayPtr3d = real(localPet,ESMF_KIND_R8) ! initialize each DE-local data chunk of Array
!print *, "farrayPtr3d:", farrayPtr3d
! prepare srcfarray on all PETs -> serves as ref. in comparison after scatter
allocate(srcfarray3d(1:15, 1:23, 10))
allocate(srcfarray3d_save(1:15, 1:23, 10))
do k=lbound(srcfarray3d,3), ubound(srcfarray3d,3)
do j=lbound(srcfarray3d,2), ubound(srcfarray3d,2)
do i=lbound(srcfarray3d,1), ubound(srcfarray3d,1)
srcfarray3d(i,j,k) = 123._ESMF_KIND_R8*sin(real(i,ESMF_KIND_R8)) + &
321._ESMF_KIND_R8*cos(real(j,ESMF_KIND_R8)) + &
20._ESMF_KIND_R8*real(k,ESMF_KIND_R8)
srcfarray3d_save(i,j,k) = srcfarray3d(i,j,k)
enddo
enddo
enddo
!print *, "srcfarray3d:", srcfarray3d
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "2D+1 non-contiguous exclusive region ArrayScatter() Test"
call ESMF_ArrayScatter(array, srcfarray3d, rootPet=0, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!call ESMF_ArrayPrint(array)
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "ArrayGet() Test"
call ESMF_ArrayGet(array, exclusiveLBound=exclusiveLBound, &
exclusiveUBound=exclusiveUBound, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Verify srcfarray3d data after scatter
write(failMsg, *) "Source data was modified."
write(name, *) "Verifying srcfarray3d data after 2D+1 non-contiguous exclusive ",&
"region ArrayScatter() Test"
rc = ESMF_SUCCESS
do k=lbound(srcfarray3d,3), ubound(srcfarray3d,3)
do j=lbound(srcfarray3d,2), ubound(srcfarray3d,2)
do i=lbound(srcfarray3d,1), ubound(srcfarray3d,1)
value = 123._ESMF_KIND_R8*sin(real(i,ESMF_KIND_R8)) + &
321._ESMF_KIND_R8*cos(real(j,ESMF_KIND_R8)) + &
20._ESMF_KIND_R8*real(k,ESMF_KIND_R8)
value = srcfarray3d(i,j,k) - srcfarray3d_save(i,j,k)
if (abs(value) > min_R8) then
print *, "Found mismatch value", i, j, k, value
rc = ESMF_FAILURE
endif
enddo
enddo
enddo
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Verify Array data after scatter
write(name, *) "Verifying destination Array data after 2D+1 non-contiguous ",&
"exclusive region ArrayScatter() Test"
write(failMsg, *) "Array data wrong."
rc = ESMF_SUCCESS
do k=lbound(farrayPtr3d,3), ubound(farrayPtr3d,3)
kk = k - lbound(farrayPtr3d,3) + lbound(srcfarray3d,3)
do j=exclusiveLBound(2,1), exclusiveUBound(2,1)
do i=exclusiveLBound(1,1), exclusiveUBound(1,1)
if (abs(farrayPtr3d(i,j,k) - srcfarray3d(i,j,kk)) > min_R8) then
print *, "Found mismatch value", i, j, k, &
abs(farrayPtr3d(i,j,k) - srcfarray3d(i,j,kk))
rc = ESMF_FAILURE
endif
enddo
enddo
enddo
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
! cleanup
call ESMF_ArrayDestroy(array, 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)
deallocate(srcfarray3d)
deallocate(srcfarray3d_save)
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!------------------------------------------------------------------------
! preparations for testing ArrayScatter() for a 2D+1 Array with
! non-contiguous exclusive region and cyclic decomposition
call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R8, rank=3, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
distgrid = ESMF_DistGridCreate(minIndex=(/0,1/), maxIndex=(/14,23/), &
regDecomp=(/2,2/), decompflag=(/ESMF_DECOMP_BALANCED,ESMF_DECOMP_CYCLIC/),&
rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, &
totalLWidth=(/2,3/), totalUWidth=(/3,4/), &
undistLBound=(/-5/), undistUBound=(/4/), rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!call ESMF_ArrayPrint(array)
call ESMF_ArrayGet(array, farrayPtr=farrayPtr3d, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
farrayPtr3d = real(localPet,ESMF_KIND_R8) ! initialize each DE-local data chunk of Array
!print *, "farrayPtr3d:", farrayPtr3d
! prepare srcfarray on all PETs -> serves as ref. in comparison after scatter
allocate(srcfarray3d(15, 23, 10))
allocate(srcfarray3d_save(15, 23, 10))
do k=lbound(srcfarray3d,3), ubound(srcfarray3d,3)
do j=lbound(srcfarray3d,2), ubound(srcfarray3d,2)
do i=lbound(srcfarray3d,1), ubound(srcfarray3d,1)
srcfarray3d(i,j,k) = 123._ESMF_KIND_R8*sin(real(i,ESMF_KIND_R8)) + &
321._ESMF_KIND_R8*cos(real(j,ESMF_KIND_R8)) + &
20._ESMF_KIND_R8*real(k,ESMF_KIND_R8)
srcfarray3d_save(i,j,k) = srcfarray3d(i,j,k)
enddo
enddo
enddo
!print *, "srcfarray3d:", srcfarray3d
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
write(name, *) "2D+1 non-contiguous exclusive region and cyclic decomposition ",&
"ArrayScatter() Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayScatter(array, srcfarray3d, rootPet=0, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!call ESMF_ArrayPrint(array)
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "ArrayGet() Test"
call ESMF_ArrayGet(array, localDe=0, dim=1, indexCount=dimExtent1, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
allocate(indexList1(dimExtent1))
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "ArrayGet() Test"
call ESMF_ArrayGet(array, localDe=0, dim=1, indexList=indexList1, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "ArrayGet() Test"
call ESMF_ArrayGet(array, localDe=0, dim=2, indexCount=dimExtent2, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
allocate(indexList2(dimExtent2))
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "ArrayGet() Test"
call ESMF_ArrayGet(array, localDe=0, dim=2, indexList=indexList2, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Verify srcfarray3d data after scatter
write(name, *) "Verifying srcfarray3d data after 2D+1 non-contiguous ",&
"exclusive region and cyclic decomposition ArrayScatter() Test"
write(failMsg, *) "Source data was modified."
rc = ESMF_SUCCESS
do k=lbound(srcfarray3d,3), ubound(srcfarray3d,3)
do j=lbound(srcfarray3d,2), ubound(srcfarray3d,2)
do i=lbound(srcfarray3d,1), ubound(srcfarray3d,1)
value = 123._ESMF_KIND_R8*sin(real(i,ESMF_KIND_R8)) + &
321._ESMF_KIND_R8*cos(real(j,ESMF_KIND_R8)) + &
20._ESMF_KIND_R8*real(k,ESMF_KIND_R8)
value = srcfarray3d(i,j,k) - srcfarray3d_save(i,j,k)
if (abs(value) > min_R8) then
print *, "Found mismatch value", i, j, k, value
rc = ESMF_FAILURE
endif
enddo
enddo
enddo
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Verify Array data after scatter
write(name, *) "Verifying destination Array data after 2D+1 non-contiguous ",&
"exclusive region and cyclic decomposition ArrayScatter() Test"
write(failMsg, *) "Array data wrong."
rc = ESMF_SUCCESS
do k=lbound(farrayPtr3d,3), ubound(farrayPtr3d,3)
! correct wrt lbound
kk = k - lbound(farrayPtr3d,3) + lbound(srcfarray3d,3)
do j=1, dimExtent2
! dereference via indexList and correct wrt lbound
jj = indexList2(j) - 1 + lbound(srcfarray3d,2)
do i=1, dimExtent1
! dereference via indexList and correct wrt lbound
ii = indexList1(i) - 0 + lbound(srcfarray3d,1)
if (abs(farrayPtr3d(i,j,k) - srcfarray3d(ii,jj,kk)) > min_R8) then
print *, "Found mismatch value", i, j, k, &
abs(farrayPtr3d(i,j,k) - srcfarray3d(ii,jj,kk))
rc = ESMF_FAILURE
endif
enddo
enddo
enddo
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
! cleanup
call ESMF_ArrayDestroy(array, 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)
deallocate(srcfarray3d)
deallocate(srcfarray3d_save)
deallocate(indexList1)
deallocate(indexList2)
#endif
10 continue
!------------------------------------------------------------------------
call ESMF_TestEnd(ESMF_SRCLINE) ! calls ESMF_Finalize() internally
!------------------------------------------------------------------------
end program ESMF_ArrayScatterUTest