program ESMF_ArrayCreateGetUTest
!------------------------------------------------------------------------------
#include "ESMF_Macros.inc"
#include "ESMF.h"
!==============================================================================
!BOP
! !PROGRAM: ESMF_ArrayCreateGetUTest - This unit test file tests ArrayCreate()
! and ArrayGet() methods.
! !DESCRIPTION:
!
! The code in this file drives Fortran ArrayCreate(), ArrayGet() 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
character(ESMF_MAXSTR) :: msg
!LOCAL VARIABLES:
type(ESMF_VM):: vm
integer:: i,j,k,l, next, rank, dimCount
integer:: undistDimCount, replicatedDimCount
integer:: petCount, localPet, deCount, de, localDeCount, lde, ssiLocalDeCount
integer, allocatable :: regDecomp(:)
type(ESMF_ArraySpec) :: arrayspec, arrayspec2
type(ESMF_LocalArray), allocatable :: localArrayList(:)
type(ESMF_Array):: array, arrayAlias, arrayDup, arrayUnInit
type(ESMF_DELayout):: delayout
type(ESMF_DistGrid):: distgrid
real(ESMF_KIND_R8) :: diffR8
real(ESMF_KIND_R4) :: diffR4
real(ESMF_KIND_R8) :: farray1D(10)
real(ESMF_KIND_R8) :: farray2D(10,10)
real(ESMF_KIND_R4) :: farray3D(10,10,10)
integer(ESMF_KIND_I4) :: farray4D(10,10,10,10)
real(ESMF_KIND_R8), pointer :: farrayPtr1D(:)
real(ESMF_KIND_R8), pointer :: farrayPtr2D(:,:), farrayPtr2DCpy(:,:)
real(ESMF_KIND_R8), pointer :: farrayPtr3DR8(:,:,:)
real(ESMF_KIND_R4), pointer :: farrayPtr3D(:,:,:)
real(ESMF_KIND_R4), pointer :: farrayPtr3Dx(:,:,:)
integer(ESMF_KIND_I4), pointer :: farrayPtr4D(:,:,:,:)
real(ESMF_KIND_R4), pointer :: farrayPtr4DR4(:,:,:,:)
character (len=80) :: arrayName
integer, allocatable:: totalLWidth(:,:), totalUWidth(:,:)
integer, allocatable:: totalLBound(:,:), totalUBound(:,:)
integer, allocatable:: computationalLWidth(:,:), computationalUWidth(:,:)
integer, allocatable:: minIndexPDe(:,:), maxIndexPDe(:,:)
integer, allocatable:: exclusiveLBound(:,:), exclusiveUBound(:,:)
integer, allocatable:: localDeToDeMap(:), arrayToDistGridMap(:)
integer, allocatable:: undistLBound(:), undistUBound(:)
logical:: arrayBool
logical:: isCreated
logical:: dataCorrect
logical:: ssiSharedMemoryEnabled
logical:: isESMFAllocated
integer:: count
!-------------------------------------------------------------------------------
! 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, &
ssiSharedMemoryEnabledFlag=ssiSharedMemoryEnabled, 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
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Testing Array IsCreated for uncreated object"
write(failMsg, *) "Did not return .false."
isCreated = ESMF_ArrayIsCreated(array)
call ESMF_Test((isCreated .eqv. .false.), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Testing Array IsCreated for uncreated object"
write(failMsg, *) "Did not return ESMF_SUCCESS"
isCreated = ESMF_ArrayIsCreated(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
! DistGrid preparation
allocate(regDecomp(2))
call ESMF_DistGridRegDecompSetCubic(regDecomp, rc=rc) ! expect 2 x 2
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/15,23/), &
regDecomp=regDecomp, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
deallocate(regDecomp)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Create test Array for IsCreated"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(typekind=ESMF_TYPEKIND_R8, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, name="MyArray", rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Testing Array IsCreated for created object"
write(failMsg, *) "Did not return .true."
isCreated = ESMF_ArrayIsCreated(array)
call ESMF_Test((isCreated .eqv. .true.), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Testing Array IsCreated for created object"
write(failMsg, *) "Did not return ESMF_SUCCESS"
isCreated = ESMF_ArrayIsCreated(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Destroy test Array for IsCreated"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Testing Array IsCreated for destroyed object"
write(failMsg, *) "Did not return .false."
isCreated = ESMF_ArrayIsCreated(array)
call ESMF_Test((isCreated .eqv. .false.), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Testing Array IsCreated for destroyed object"
write(failMsg, *) "Did not return ESMF_SUCCESS"
isCreated = ESMF_ArrayIsCreated(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate Allocate 2D ESMF_TYPEKIND_R8 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(typekind=ESMF_TYPEKIND_R8, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, name="MyArray", rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Array equality before assignment Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
arrayBool = (arrayAlias.eq.array)
call ESMF_Test(.not.arrayBool, name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Testing ESMF_ArrayAssignment(=)()
write(name, *) "Array assignment and equality Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
arrayAlias = array
arrayBool = (arrayAlias.eq.array)
call ESMF_Test(arrayBool, name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Testing ESMF_ArrayOperator(==)()
write(name, *) "Array equality after destroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
arrayBool = (arrayAlias==array)
call ESMF_Test(.not.arrayBool, name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Testing ESMF_ArrayOperator(/=)()
write(name, *) "Array non-equality after destroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
arrayBool = (arrayAlias/=array)
call ESMF_Test(arrayBool, name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Double ArrayDestroy through alias Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(arrayAlias, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate Allocate 2D ESMF_TYPEKIND_R8 rank inconsistency Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(typekind=ESMF_TYPEKIND_R8, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, undistLBound=(/0/), undistUBound=(/2,2/), &
name="MyArray", rc=rc)
call ESMF_Test((rc.ne.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate Allocate 2D ESMF_TYPEKIND_R8 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(typekind=ESMF_TYPEKIND_R8, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, name="MyArray", rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArraySet Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArraySet(array, name="MyArrayNewName", rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
! ArraySpec preparation
call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R8, rank=2, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate Allocate 2D ESMF_TYPEKIND_R8 Test w/ ArraySpec"
write(failMsg, *) "Incorrectly returned ESMF_SUCCESS"
! Should not return ESMF_SUCCESS due to / in name
array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, name="MyArray w/ ArraySpec", rc=rc)
call ESMF_Test((rc /= ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate Allocate 2D ESMF_TYPEKIND_R8 Test with ArraySpec"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, name="MyArray with ArraySpec", rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayPrint 2D ESMF_TYPEKIND_R8 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayPrint(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet arrayspec and name, 2D ESMF_TYPEKIND_R8 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, arrayspec=arrayspec2, name=arrayName, rc=rc)
print *, "Array name: ", arrayname
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Verify ArraySpec returned from Array"
write(failMsg, *) "Incorrect ArraySpec"
call ESMF_Test((arrayspec2==arrayspec), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Verify name returned from Array"
write(failMsg, *) "Incorrect name"
call ESMF_Test((trim(arrayName)=="MyArray with ArraySpec"), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet replicatedDimCount Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, replicatedDimCount=replicatedDimCount, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Verify replicatedDimCount returned from Array with 0 replicated dims"
write(failMsg, *) "Incorrect replicatedDimCount"
call ESMF_Test(replicatedDimCount==0, name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet Fortran array pointer, 2D ESMF_TYPEKIND_R8 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, farrayPtr=farrayPtr2D, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Getting Attribute count from an Array"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_AttributeGet(array, count, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Verify Attribute count from an Array"
write(failMsg, *) "Incorrect count"
call ESMF_Test((count.eq.0), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate from Copy, uninitialized Array Test"
write(failMsg, *) "Incorrectly returned ESMF_SUCCESS"
arrayDup = ESMF_ArrayCreate(arrayUnInit, rc=rc)
call ESMF_Test((rc /= ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate from Copy (ALLOC), 2D ESMF_TYPEKIND_R8 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
farrayPtr2D = real(localPet+10, ESMF_KIND_R8) ! fill with data to check
arrayDup = ESMF_ArrayCreate(array, datacopyflag=ESMF_DATACOPY_ALLOC, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet arrayspec from Array Copy (ALLOC) Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, arrayspec=arrayspec2, name=arrayName, rc=rc)
print *, "Array name: ", arrayname
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Verify ArraySpec returned from Array (ALLOC) Copy"
write(failMsg, *) "Incorrect ArraySpec"
call ESMF_Test((arrayspec2==arrayspec), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet Fortran array pointer, from Array Copy (ALLOC) Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, farrayPtr=farrayPtr2DCpy, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Verify Array vs Array Copy (ALLOC) no data copy"
write(failMsg, *) "Unexpected data copy"
dataCorrect = .true.
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
write (msg,*) "farrayPtr2D(",i,",",j,")=", farrayPtr2D(i,j), &
" farrayPtr2DCpy(",i,",",j,")=", farrayPtr2DCpy(i,j)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
if (abs(farrayPtr2D(i,j)-farrayPtr2DCpy(i,j)) < 1.d-10) dataCorrect=.false.
enddo
enddo
call ESMF_Test((dataCorrect), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Verify Array vs Array Copy (ALLOC) separate memory allocation"
write(failMsg, *) "Unexpected reference sharing"
farrayPtr2D = real(localPet+10, ESMF_KIND_R8)
farrayPtr2DCpy = real(localPet+100, ESMF_KIND_R8)
dataCorrect = .true.
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
write (msg,*) "farrayPtr2D(",i,",",j,")=", farrayPtr2D(i,j), &
" farrayPtr2DCpy(",i,",",j,")=", farrayPtr2DCpy(i,j)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
if (abs(farrayPtr2D(i,j)-farrayPtr2DCpy(i,j)) < 1.d-10) dataCorrect=.false.
enddo
enddo
call ESMF_Test((dataCorrect), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayPrint from Copy (ALLOC) after original destroy, 2D ESMF_TYPEKIND_R8 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayPrint(arrayDup, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy of Copy (ALLOC) Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(arrayDup, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate Allocate 2D ESMF_TYPEKIND_R8 Test with ArraySpec"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, name="MyArray with ArraySpec", rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet Fortran array pointer, 2D ESMF_TYPEKIND_R8 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, farrayPtr=farrayPtr2D, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate from Copy (VALUE), 2D ESMF_TYPEKIND_R8 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
farrayPtr2D = real(localPet+20, ESMF_KIND_R8) ! fill with data to check
arrayDup = ESMF_ArrayCreate(array, datacopyflag=ESMF_DATACOPY_VALUE, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet isESMFAllocated from Array Copy (VALUE) Test"
write(failMsg, *) "Did not return .true."
call ESMF_ArrayGet(arrayDup, isESMFAllocated=isESMFAllocated, rc=rc)
print *, "Array is allocated internally: ", isESMFAllocated
call ESMF_Test(isESMFAllocated, name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet arrayspec from Array Copy (VALUE) Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, arrayspec=arrayspec2, name=arrayName, rc=rc)
print *, "Array name: ", arrayname
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Verify ArraySpec returned from Array (VALUE) Copy"
write(failMsg, *) "Incorrect ArraySpec"
call ESMF_Test((arrayspec2==arrayspec), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet Fortran array pointer, from Array Copy (VALUE) Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, farrayPtr=farrayPtr2DCpy, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Verify Array vs Array Copy (VALUE) data copy"
write(failMsg, *) "Unexpected data copy"
dataCorrect = .true.
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
write (msg,*) "farrayPtr2D(",i,",",j,")=", farrayPtr2D(i,j), &
" farrayPtr2DCpy(",i,",",j,")=", farrayPtr2DCpy(i,j)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
if (abs(farrayPtr2D(i,j)-farrayPtr2DCpy(i,j)) > 1.d-10) dataCorrect=.false.
enddo
enddo
call ESMF_Test((dataCorrect), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Verify Array vs Array Copy (VALUE) separate memory allocation"
write(failMsg, *) "Unexpected reference sharing"
farrayPtr2D = real(localPet+20, ESMF_KIND_R8)
farrayPtr2DCpy = real(localPet+200, ESMF_KIND_R8)
dataCorrect = .true.
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
write (msg,*) "farrayPtr2D(",i,",",j,")=", farrayPtr2D(i,j), &
" farrayPtr2DCpy(",i,",",j,")=", farrayPtr2DCpy(i,j)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
if (abs(farrayPtr2D(i,j)-farrayPtr2DCpy(i,j)) < 1.d-10) dataCorrect=.false.
enddo
enddo
call ESMF_Test((dataCorrect), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy of Copy (VALUE) Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(arrayDup, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate Allocate 2D ESMF_TYPEKIND_R8 Test with ArraySpec"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, name="MyArray with ArraySpec", rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet Fortran array pointer, 2D ESMF_TYPEKIND_R8 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, farrayPtr=farrayPtr2D, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate from Copy (REF), 2D ESMF_TYPEKIND_R8 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
farrayPtr2D = real(localPet+30, ESMF_KIND_R8) ! fill with data to check
arrayDup = ESMF_ArrayCreate(array, datacopyflag=ESMF_DATACOPY_REFERENCE, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet isESMFAllocated from Array Copy (REF) Test"
write(failMsg, *) "Did not return .false."
call ESMF_ArrayGet(arrayDup, isESMFAllocated=isESMFAllocated, rc=rc)
print *, "Array is allocated internally: ", isESMFAllocated
call ESMF_Test(.not.isESMFAllocated, name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet arrayspec from Array Copy (REF) Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, arrayspec=arrayspec2, name=arrayName, rc=rc)
print *, "Array name: ", arrayname
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Verify ArraySpec returned from Array Copy (REF)"
write(failMsg, *) "Incorrect ArraySpec"
call ESMF_Test((arrayspec2==arrayspec), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet Fortran array pointer, from Array Copy (REF) Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, farrayPtr=farrayPtr2DCpy, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Verify Array vs Array Copy (REF) shared allocation Test1"
write(failMsg, *) "Unexpected separate allocations"
dataCorrect = .true.
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
write (msg,*) "farrayPtr2D(",i,",",j,")=", farrayPtr2D(i,j), &
" farrayPtr2DCpy(",i,",",j,")=", farrayPtr2DCpy(i,j)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
if (abs(farrayPtr2D(i,j)-farrayPtr2DCpy(i,j)) > 1.d-10) dataCorrect=.false.
enddo
enddo
call ESMF_Test((dataCorrect), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Verify Array vs Array Copy (REF) shared allocation Test2"
write(failMsg, *) "Unexpected separate allocations"
farrayPtr2D = real(localPet+30, ESMF_KIND_R8)
farrayPtr2DCpy = real(localPet+300, ESMF_KIND_R8)
dataCorrect = .true.
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
write (msg,*) "farrayPtr2D(",i,",",j,")=", farrayPtr2D(i,j), &
" farrayPtr2DCpy(",i,",",j,")=", farrayPtr2DCpy(i,j)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
if (abs(farrayPtr2D(i,j)-farrayPtr2DCpy(i,j)) > 1.d-10) dataCorrect=.false.
enddo
enddo
call ESMF_Test((dataCorrect), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy of Copy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(arrayDup, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate from Ptr with 3D farray on 2D DistGrid Test as Ptr"
write(failMsg, *) "Did not return ESMF_SUCCESS"
allocate(farrayPtr3D(-2:6,12,3:10))
array = ESMF_ArrayCreate(farrayPtr=farrayPtr3D, distgrid=distgrid, &
name="MyArray", rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayPrint for ArrayCreate from Ptr Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayPrint(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, farrayPtr=farrayPtr3Dx, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Deallocate returned pointer Test"
write(failMsg, *) "Did not return success"
deallocate(farrayPtr3Dx, stat=rc)
call ESMF_Test((rc.eq.0), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate with 3D farray on 2D DistGrid Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
allocate(farrayPtr3D(8,12,10))
array = ESMF_ArrayCreate(farray=farrayPtr3D, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, name="MyArray", rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
deallocate(farrayPtr3D)
nullify(farrayPtr3D)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate with 3D farray on 2D DistGrid w/ ESMF_DATACOPY_VALUE Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
allocate(farrayPtr3D(8,12,10))
array = ESMF_ArrayCreate(farray=farrayPtr3D, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, name="MyArray", datacopyflag=ESMF_DATACOPY_VALUE, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
deallocate(farrayPtr3D)
nullify(farrayPtr3D)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate with 3D farrayPtr on 2D DistGrid w/ ESMF_DATACOPY_VALUE Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
allocate(farrayPtr3D(8,12,10))
array = ESMF_ArrayCreate(farrayPtr=farrayPtr3D, distgrid=distgrid, &
name="MyArray", datacopyflag=ESMF_DATACOPY_VALUE, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
deallocate(farrayPtr3D)
nullify(farrayPtr3D)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate with 3D farray on 2D DistGrid w/ distgridToArrayMap Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
allocate(farrayPtr3D(12,13,10))
array = ESMF_ArrayCreate(farray=farrayPtr3D, distgrid=distgrid, &
distgridToArrayMap=(/2,1/), computationalLWidth=(/0,5/), &
indexflag=ESMF_INDEX_GLOBAL, name="MyArray", rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
deallocate(farrayPtr3D)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate with 1D farray on 2D DistGrid all replicated dims Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
allocate(farrayPtr1D(-10:15))
array = ESMF_ArrayCreate(farrayPtr=farrayPtr1D, distgrid=distgrid, &
distgridToArrayMap=(/0,0/), name="MyArrayAllReplicated", rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet for all replicated dims Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, rank=rank, dimCount=dimCount, &
undistDimCount=undistDimCount, replicatedDimCount=replicatedDimCount, &
rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Validate rank==1 for all replicated dims Test"
write(failMsg, *) "Rank is wrong: ", rank
call ESMF_Test((rank==1), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Validate dimCount==2 for all replicated dims Test"
write(failMsg, *) "dimCount is wrong:", dimCount
call ESMF_Test((dimCount==2), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Validate undistDimCount==1 for all replicated dims Test"
write(failMsg, *) "undistDimCount is wrong: ", undistDimCount
call ESMF_Test((undistDimCount==1), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Validate replicatedDimCount==2 for all replicated dims Test"
write(failMsg, *) "replicatedDimCount is wrong: ", replicatedDimCount
call ESMF_Test((replicatedDimCount==2), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet undist bounds for all replicated dims Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
allocate(undistLBound(undistDimCount),undistUBound(undistDimCount))
call ESMF_ArrayGet(array, undistLBound=undistLBound, &
undistUBound=undistUBound, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Validate undistLBound==[-10] for all replicated dims Test"
write(failMsg, *) "undistLBound is wrong: ", undistLBound
call ESMF_Test(all(undistLBound==[-10]), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Validate undistUBound==[15] for all replicated dims Test"
write(failMsg, *) "undistUBound is wrong: ", undistUBound
call ESMF_Test(all(undistUBound==[15]), name, failMsg, result, ESMF_SRCLINE)
deallocate(undistLBound,undistUBound)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy for all replicated dims Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate Allocate 2D ESMF_TYPEKIND_R8 w/ negative computational widths Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, computationalLWidth=(/-1,-1/), &
computationalUWidth=(/-2,-3/), name="MyArray Negative", rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayPrint 2D ESMF_TYPEKIND_R8 w/ computational widths Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayPrint(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate Allocate 2D ESMF_TYPEKIND_R8 w/ computationalEdge widths Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, computationalEdgeLWidth=(/0,-1/), &
computationalEdgeUWidth=(/-2,+1/), name="MyArray Negative Edge", rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayPrint 2D ESMF_TYPEKIND_R8 w/ computationalEdge widths Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayPrint(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet 2D ESMF_TYPEKIND_R8 w/ computationalEdge widths Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
allocate(totalLWidth(2,1))
allocate(totalUWidth(2,1))
allocate(computationalLWidth(2,1))
allocate(computationalUWidth(2,1))
call ESMF_ArrayGet(array, totalLWidth=totalLWidth, totalUWidth=totalUWidth, &
computationalLWidth=computationalLWidth, &
computationalUWidth=computationalUWidth, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Check total widths for 2D ESMF_TYPEKIND_R8 w/ computationalEdge widths Test"
write(failMsg, *) "Total widths are wrong"
call ESMF_Test((totalLWidth(1,1)==max(0,computationalLWidth(1,1))&
.and.totalLWidth(2,1)==max(0,computationalLWidth(2,1))&
.and.totalUWidth(1,1)==max(0,computationalUWidth(1,1))&
.and.totalUWidth(2,1)==max(0,computationalUWidth(2,1))), &
name, failMsg, result, ESMF_SRCLINE)
deallocate(totalLWidth, totalUWidth)
deallocate(computationalLWidth, computationalUWidth)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate Allocate 2D ESMF_TYPEKIND_R8 w/ computationalEdge and total widths Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, computationalEdgeLWidth=(/0,-1/), &
computationalEdgeUWidth=(/-2,+1/), totalLWidth=(/1,2/), totalUWidth=(/3,4/),&
name="MyArray Negative Edge", rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayPrint 2D ESMF_TYPEKIND_R8 w/ computationalEdge and total widths Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayPrint(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet 2D ESMF_TYPEKIND_R8 w/ computationalEdge and total widths Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
allocate(totalLWidth(2,1))
allocate(totalUWidth(2,1))
allocate(totalLBound(2,1))
allocate(totalUBound(2,1))
call ESMF_ArrayGet(array, totalLWidth=totalLWidth, totalUWidth=totalUWidth, &
totalLBound=totalLBound, totalUBound=totalUBound, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Check total widths for 2D ESMF_TYPEKIND_R8 w/ computationalEdge and total widths Test"
write(failMsg, *) "Total widths are wrong"
call ESMF_Test((totalLWidth(1,1)==1.and.totalLWidth(2,1)==2.and.&
totalUWidth(1,1)==3.and.totalUWidth(2,1)==4), &
name, failMsg, result, ESMF_SRCLINE)
deallocate(totalLWidth, totalUWidth)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Check total bounds for 2D ESMF_TYPEKIND_R8 w/ computationalEdge and total widths Test"
write(failMsg, *) "Total bounds are wrong"
if (localPet==0) then
call ESMF_Test((totalLBound(1,1)==0.and.totalLBound(2,1)==-1.and.&
totalUBound(1,1)==11.and.totalUBound(2,1)==16), &
name, failMsg, result, ESMF_SRCLINE)
else if (localPet==1) then
call ESMF_Test((totalLBound(1,1)==8.and.totalLBound(2,1)==-1.and.&
totalUBound(1,1)==18.and.totalUBound(2,1)==16), &
name, failMsg, result, ESMF_SRCLINE)
else if (localPet==2) then
call ESMF_Test((totalLBound(1,1)==0.and.totalLBound(2,1)==11.and.&
totalUBound(1,1)==11.and.totalUBound(2,1)==27), &
name, failMsg, result, ESMF_SRCLINE)
else if (localPet==3) then
call ESMF_Test((totalLBound(1,1)==8.and.totalLBound(2,1)==11.and.&
totalUBound(1,1)==18.and.totalUBound(2,1)==27), &
name, failMsg, result, ESMF_SRCLINE)
endif
deallocate(totalLBound, totalUBound)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Create test Array with ESMF_PIN_DE_TO_PET"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(typekind=ESMF_TYPEKIND_R8, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, pinflag=ESMF_PIN_DE_TO_PET, name="MyArray", &
rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet Fortran array pointer for ESMF_PIN_DE_TO_PET Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, farrayPtr=farrayPtr2D, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "Local Array lbounds=", lbound(farrayPtr2D)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
write (msg,*) "Local Array ubounds=", ubound(farrayPtr2D)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test for array with ESMF_PIN_DE_TO_PET"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Create test Array with ESMF_PIN_DE_TO_SSI"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(typekind=ESMF_TYPEKIND_R8, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, pinflag=ESMF_PIN_DE_TO_SSI, name="MyArray", &
rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMC_RC_INTNRL_BAD), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet Fortran array pointer for ESMF_PIN_DE_TO_SSI Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, farrayPtr=farrayPtr2D, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "Local Array lbounds=", lbound(farrayPtr2D)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
write (msg,*) "Local Array ubounds=", ubound(farrayPtr2D)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet ssiLocalDeCount ESMF_PIN_DE_TO_SSI Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, ssiLocalDeCount=ssiLocalDeCount, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "ssiLocalDeCount=", ssiLocalDeCount
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
ssiLocalDeCount=1
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
allocate(localDeToDeMap(ssiLocalDeCount))
allocate(localArrayList(ssiLocalDeCount))
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet localDeToDeMap, etc. ESMF_PIN_DE_TO_SSI Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, localDeToDeMap=localDeToDeMap, &
localarrayList=localArrayList, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "localDeToDeMap=", localDeToDeMap
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
! initialize the data on this PETs first localDE
if (ssiSharedMemoryEnabled) then
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
farrayPtr2D(i,j) = real(localDeToDeMap(1)+5,ESMF_KIND_R8) &
* sin(real(i,ESMF_KIND_R8)) &
* sin(real(j,ESMF_KIND_R8))
enddo
enddo
endif
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArraySync() for ESMF_PIN_DE_TO_SSI Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArraySync(array, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "LocalArrayGet Fortran array pointer for next ssiLocalDe for ESMF_PIN_DE_TO_SSI Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
next = localPet + 2
if (next > ssiLocalDeCount) next = 1
call ESMF_LocalArrayGet(localArrayList(next), &
farrayPtr=farrayPtr2D, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "localDeToDeMap(next)=", localDeToDeMap(next)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
write (msg,*) "Local Array lbounds=", lbound(farrayPtr2D)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
write (msg,*) "Local Array ubounds=", ubound(farrayPtr2D)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Validate data in LocalArray for next ssiLocalDe for ESMF_PIN_DE_TO_SSI Test"
write(failMsg, *) "Data not correct"
dataCorrect = .true. ! initialize
if (ssiSharedMemoryEnabled) then
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
write (msg,*) "data(",i,",",j,")=", farrayPtr2D(i,j)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
diffR8 = farrayPtr2D(i,j) - &
real(localDeToDeMap(next)+5,ESMF_KIND_R8) &
* sin(real(i,ESMF_KIND_R8)) &
* sin(real(j,ESMF_KIND_R8))
if (abs(diffR8) > 1.d-10) then
dataCorrect=.false.
write (msg,*) "diffR8=", diffR8
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
endif
enddo
enddo
else
! dummy test
endif
call ESMF_Test((dataCorrect), name, failMsg, result, ESMF_SRCLINE)
call ESMF_ArraySync(array, rc=rc) ! prevent race condition with below
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
deallocate(localDeToDeMap)
deallocate(localArrayList)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate from Copy (REF), ESMF_PIN_DE_TO_SSI Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
arrayDup = ESMF_ArrayCreate(array, datacopyflag=ESMF_DATACOPY_REFERENCE, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet Fortran array pointer for ESMF_PIN_DE_TO_SSI arrayDup Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, farrayPtr=farrayPtr2D, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "Local Array lbounds=", lbound(farrayPtr2D)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
write (msg,*) "Local Array ubounds=", ubound(farrayPtr2D)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet ssiLocalDeCount ESMF_PIN_DE_TO_SSI arrayDup Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, ssiLocalDeCount=ssiLocalDeCount, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "ssiLocalDeCount=", ssiLocalDeCount
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
ssiLocalDeCount=1
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
allocate(localDeToDeMap(ssiLocalDeCount))
allocate(localArrayList(ssiLocalDeCount))
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet localDeToDeMap, etc. ESMF_PIN_DE_TO_SSI arrayDup Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, localDeToDeMap=localDeToDeMap, &
localarrayList=localArrayList, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "localDeToDeMap=", localDeToDeMap
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
! initialize the data on this PETs first localDE
if (ssiSharedMemoryEnabled) then
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
farrayPtr2D(i,j) = real(10*(localDeToDeMap(1)+5),ESMF_KIND_R8) &
* sin(real(i,ESMF_KIND_R8)) &
* sin(real(j,ESMF_KIND_R8))
enddo
enddo
endif
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArraySync() for ESMF_PIN_DE_TO_SSI arrayDup Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArraySync(arrayDup, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "LocalArrayGet Fortran array pointer for next ssiLocalDe for ESMF_PIN_DE_TO_SSI arrayDup Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
next = localPet + 2
if (next > ssiLocalDeCount) next = 1
call ESMF_LocalArrayGet(localArrayList(next), &
farrayPtr=farrayPtr2D, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "localDeToDeMap(next)=", localDeToDeMap(next)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
write (msg,*) "Local Array lbounds=", lbound(farrayPtr2D)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
write (msg,*) "Local Array ubounds=", ubound(farrayPtr2D)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Validate data in LocalArray for next ssiLocalDe for ESMF_PIN_DE_TO_SSI arrayDup Test"
write(failMsg, *) "Data not correct"
dataCorrect = .true. ! initialize
if (ssiSharedMemoryEnabled) then
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
write (msg,*) "data(",i,",",j,")=", farrayPtr2D(i,j)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
diffR8 = farrayPtr2D(i,j) - &
real(10*(localDeToDeMap(next)+5),ESMF_KIND_R8) &
* sin(real(i,ESMF_KIND_R8)) &
* sin(real(j,ESMF_KIND_R8))
if (abs(diffR8) > 1.d-10) then
dataCorrect=.false.
write (msg,*) "diffR8=", diffR8
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
endif
enddo
enddo
else
! dummy test
endif
call ESMF_Test((dataCorrect), name, failMsg, result, ESMF_SRCLINE)
call ESMF_ArraySync(arrayDup, rc=rc) ! prevent race condition with below
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
deallocate(localDeToDeMap)
deallocate(localArrayList)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test for arrayDup with ESMF_PIN_DE_TO_SSI"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(arrayDup, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate from Copy (REF), ESMF_PIN_DE_TO_SSI w/ DELayout Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
delayout = ESMF_DELayoutCreate((/0,0,2,2/), rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
arrayDup = ESMF_ArrayCreate(array, datacopyflag=ESMF_DATACOPY_REFERENCE, &
delayout=delayout, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayPrint from Copy (REF), ESMF_PIN_DE_TO_SSI w/ DELayout Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayPrint(arrayDup, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet ssiLocalDeCount ESMF_PIN_DE_TO_SSI arrayDup Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, ssiLocalDeCount=ssiLocalDeCount, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "ssiLocalDeCount=", ssiLocalDeCount
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
ssiLocalDeCount=1
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
allocate(localDeToDeMap(ssiLocalDeCount))
allocate(localArrayList(ssiLocalDeCount))
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet localDeToDeMap, etc. ESMF_PIN_DE_TO_SSI arrayDup Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, localDeToDeMap=localDeToDeMap, &
localarrayList=localArrayList, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "localDeToDeMap=", localDeToDeMap
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Validate data in LocalArray for all DEs for ESMF_PIN_DE_TO_SSI arrayDup Test"
write(failMsg, *) "Data not correct"
dataCorrect = .true. ! initialize
if (ssiSharedMemoryEnabled) then
do lde=1, ssiLocalDeCount
call ESMF_LocalArrayGet(localArrayList(lde), farrayPtr=farrayPtr2D, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
write (msg,*) "localDE=",lde-1," DE=", localDeToDeMap(lde), &
" data(",i,",",j,")=", farrayPtr2D(i,j)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
diffR8 = farrayPtr2D(i,j) - &
real(10*(localDeToDeMap(lde)+5),ESMF_KIND_R8) &
* sin(real(i,ESMF_KIND_R8)) &
* sin(real(j,ESMF_KIND_R8))
if (abs(diffR8) > 1.d-10) then
dataCorrect=.false.
write (msg,*) "diffR8=", diffR8
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
endif
enddo
enddo
enddo
else
! dummy test
endif
call ESMF_Test((dataCorrect), name, failMsg, result, ESMF_SRCLINE)
call ESMF_ArraySync(arrayDup, rc=rc) ! prevent race condition with below
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
deallocate(localDeToDeMap)
deallocate(localArrayList)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArraySync() for ESMF_PIN_DE_TO_SSI arrayDup Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArraySync(arrayDup, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test for arrayDup with ESMF_PIN_DE_TO_SSI w/ DELayout"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(arrayDup, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test for array with ESMF_PIN_DE_TO_SSI"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Create test 2D+1 Array with ESMF_PIN_DE_TO_SSI"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(typekind=ESMF_TYPEKIND_R8, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, pinflag=ESMF_PIN_DE_TO_SSI, name="MyArray", &
undistLBound=[1], undistUBound=[3], rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMC_RC_INTNRL_BAD), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet Fortran array pointer for ESMF_PIN_DE_TO_SSI 2D+1 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, farrayPtr=farrayPtr3DR8, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "Local Array lbounds=", lbound(farrayPtr3DR8)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
write (msg,*) "Local Array ubounds=", ubound(farrayPtr3DR8)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet rank, ssiLocalDeCount ESMF_PIN_DE_TO_SSI 2D+1 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, rank=rank, ssiLocalDeCount=ssiLocalDeCount, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "ssiLocalDeCount=", ssiLocalDeCount
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
ssiLocalDeCount=1
rank=1
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
allocate(localDeToDeMap(ssiLocalDeCount))
allocate(localArrayList(ssiLocalDeCount))
allocate(arrayToDistGridMap(rank))
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Validate rank for ESMF_PIN_DE_TO_SSI 2D+1 Test"
write(failMsg, *) "Rank is wrong"
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rank==3), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "rank=", rank
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
! dummy test call
call ESMF_Test((.true.), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet localDeToDeMap, etc. ESMF_PIN_DE_TO_SSI 2D+1 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, localDeToDeMap=localDeToDeMap, &
localarrayList=localArrayList, arrayToDistGridMap=arrayToDistGridMap, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "localDeToDeMap=", localDeToDeMap
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
write (msg,*) "arrayToDistGridMap=", arrayToDistGridMap
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
! initialize the data on this PETs first localDE
if (ssiSharedMemoryEnabled) then
do k=lbound(farrayPtr3DR8,3), ubound(farrayPtr3DR8,3)
do j=lbound(farrayPtr3DR8,2), ubound(farrayPtr3DR8,2)
do i=lbound(farrayPtr3DR8,1), ubound(farrayPtr3DR8,1)
farrayPtr3DR8(i,j,k) = real(localDeToDeMap(1)+5,ESMF_KIND_R8) &
* sin(real(i,ESMF_KIND_R8)) &
* sin(real(j,ESMF_KIND_R8)) &
* sin(real(k,ESMF_KIND_R8))
enddo
enddo
enddo
endif
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArraySync() for ESMF_PIN_DE_TO_SSI 2D+1 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArraySync(array, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "LocalArrayGet Fortran array pointer for next ssiLocalDe "//&
"for ESMF_PIN_DE_TO_SSI 2D+1 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
next = localPet + 2
if (next > ssiLocalDeCount) next = 1
call ESMF_LocalArrayGet(localArrayList(next), &
farrayPtr=farrayPtr3DR8, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "localDeToDeMap(next)=", localDeToDeMap(next)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
write (msg,*) "Local Array lbounds=", lbound(farrayPtr3DR8)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
write (msg,*) "Local Array ubounds=", ubound(farrayPtr3DR8)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Validate data in LocalArray for next ssiLocalDe for "//&
"ESMF_PIN_DE_TO_SSI 2D+1 Test"
write(failMsg, *) "Data not correct"
dataCorrect = .true. ! initialize
if (ssiSharedMemoryEnabled) then
do k=lbound(farrayPtr3DR8,3), ubound(farrayPtr3DR8,3)
do j=lbound(farrayPtr3DR8,2), ubound(farrayPtr3DR8,2)
do i=lbound(farrayPtr3DR8,1), ubound(farrayPtr3DR8,1)
write (msg,*) "data(",i,",",j,",",k,")=", farrayPtr3DR8(i,j,k)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
diffR8 = farrayPtr3DR8(i,j,k) - &
real(localDeToDeMap(next)+5,ESMF_KIND_R8) &
* sin(real(i,ESMF_KIND_R8)) &
* sin(real(j,ESMF_KIND_R8)) &
* sin(real(k,ESMF_KIND_R8))
if (abs(diffR8) > 1.d-10) then
dataCorrect=.false.
write (msg,*) "diffR8=", diffR8
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
endif
enddo
enddo
enddo
else
! dummy test
endif
call ESMF_Test((dataCorrect), name, failMsg, result, ESMF_SRCLINE)
call ESMF_ArraySync(array, rc=rc) ! prevent race condition with below
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
deallocate(localDeToDeMap)
deallocate(localArrayList)
deallocate(arrayToDistGridMap)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate from Copy (REF), ESMF_PIN_DE_TO_SSI "//&
"2D+1->2D Slice at k=1 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
arrayDup = ESMF_ArrayCreate(array, datacopyflag=ESMF_DATACOPY_REFERENCE, &
trailingUndistSlice=[1], rc=rc) ! create a slice
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet Fortran array pointer for ESMF_PIN_DE_TO_SSI "// &
"arrayDup 2D+1->2D Slice at k=1 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, farrayPtr=farrayPtr2D, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "Local Array lbounds=", lbound(farrayPtr2D)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
write (msg,*) "Local Array ubounds=", ubound(farrayPtr2D)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet rank, ssiLocalDeCount ESMF_PIN_DE_TO_SSI "//&
"arrayDup 2D+1->2D Slice at k=1 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, rank=rank, ssiLocalDeCount=ssiLocalDeCount, &
rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "ssiLocalDeCount=", ssiLocalDeCount
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
ssiLocalDeCount=1
rank=1
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
allocate(localDeToDeMap(ssiLocalDeCount))
allocate(localArrayList(ssiLocalDeCount))
allocate(arrayToDistGridMap(rank))
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Validate rank for ESMF_PIN_DE_TO_SSI arrayDup 2D+1->2D "//&
"Slice at k=1 Test"
write(failMsg, *) "Rank is wrong"
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rank==2), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "rank=", rank
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
! dummy test call
call ESMF_Test((.true.), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet localDeToDeMap, etc. ESMF_PIN_DE_TO_SSI arrayDup "//&
"2D+1->2D Slice at k=1 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, localDeToDeMap=localDeToDeMap, &
localarrayList=localArrayList, arrayToDistGridMap=arrayToDistGridMap, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "localDeToDeMap=", localDeToDeMap
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
write (msg,*) "arrayToDistGridMap=", arrayToDistGridMap
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Validate data in LocalArray for all DEs for "//&
"ESMF_PIN_DE_TO_SSI arrayDup 2D+1->2D Slice at k=1 Test"
write(failMsg, *) "Data not correct"
dataCorrect = .true. ! initialize
if (ssiSharedMemoryEnabled) then
k=1
do lde=1, ssiLocalDeCount
call ESMF_LocalArrayGet(localArrayList(lde), farrayPtr=farrayPtr2D, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
write (msg,*) "localDE=",lde-1," DE=", localDeToDeMap(lde), &
" data(",i,",",j,")=", farrayPtr2D(i,j)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
diffR8 = farrayPtr2D(i,j) - &
real(localDeToDeMap(lde)+5,ESMF_KIND_R8) &
* sin(real(i,ESMF_KIND_R8)) &
* sin(real(j,ESMF_KIND_R8)) &
* sin(real(k,ESMF_KIND_R8))
if (abs(diffR8) > 1.d-10) then
dataCorrect=.false.
write (msg,*) "diffR8=", diffR8
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
endif
enddo
enddo
enddo
else
! dummy test
endif
call ESMF_Test((dataCorrect), name, failMsg, result, ESMF_SRCLINE)
call ESMF_ArraySync(arrayDup, rc=rc) ! prevent race condition with below
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
deallocate(localDeToDeMap)
deallocate(localArrayList)
deallocate(arrayToDistGridMap)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArraySync() for ESMF_PIN_DE_TO_SSI arrayDup "//&
"2D+1->2D Slice at k=1 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArraySync(arrayDup, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test for arrayDup with ESMF_PIN_DE_TO_SSI "//&
"2D+1->2D Slice at k=1 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(arrayDup, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate from Copy (REF), ESMF_PIN_DE_TO_SSI "//&
"2D+1->2D Slice at k=2 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
arrayDup = ESMF_ArrayCreate(array, datacopyflag=ESMF_DATACOPY_REFERENCE, &
trailingUndistSlice=[2], rc=rc) ! create a slice
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet Fortran array pointer for ESMF_PIN_DE_TO_SSI "// &
"arrayDup 2D+1->2D Slice at k=2 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, farrayPtr=farrayPtr2D, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "Local Array lbounds=", lbound(farrayPtr2D)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
write (msg,*) "Local Array ubounds=", ubound(farrayPtr2D)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet rank, ssiLocalDeCount ESMF_PIN_DE_TO_SSI "//&
"arrayDup 2D+1->2D Slice at k=2 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, rank=rank, ssiLocalDeCount=ssiLocalDeCount, &
rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "ssiLocalDeCount=", ssiLocalDeCount
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
ssiLocalDeCount=1
rank=1
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
allocate(localDeToDeMap(ssiLocalDeCount))
allocate(localArrayList(ssiLocalDeCount))
allocate(arrayToDistGridMap(rank))
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Validate rank for ESMF_PIN_DE_TO_SSI arrayDup 2D+1->2D "//&
"Slice at k=2 Test"
write(failMsg, *) "Rank is wrong"
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rank==2), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "rank=", rank
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
! dummy test call
call ESMF_Test((.true.), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet localDeToDeMap, etc. ESMF_PIN_DE_TO_SSI arrayDup "//&
"2D+1->2D Slice at k=2 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, localDeToDeMap=localDeToDeMap, &
localarrayList=localArrayList, arrayToDistGridMap=arrayToDistGridMap, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "localDeToDeMap=", localDeToDeMap
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
write (msg,*) "arrayToDistGridMap=", arrayToDistGridMap
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Validate data in LocalArray for all DEs for "//&
"ESMF_PIN_DE_TO_SSI arrayDup 2D+1->2D Slice at k=2 Test"
write(failMsg, *) "Data not correct"
dataCorrect = .true. ! initialize
if (ssiSharedMemoryEnabled) then
k=2
do lde=1, ssiLocalDeCount
call ESMF_LocalArrayGet(localArrayList(lde), farrayPtr=farrayPtr2D, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
write (msg,*) "localDE=",lde-1," DE=", localDeToDeMap(lde), &
" data(",i,",",j,")=", farrayPtr2D(i,j)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
diffR8 = farrayPtr2D(i,j) - &
real(localDeToDeMap(lde)+5,ESMF_KIND_R8) &
* sin(real(i,ESMF_KIND_R8)) &
* sin(real(j,ESMF_KIND_R8)) &
* sin(real(k,ESMF_KIND_R8))
if (abs(diffR8) > 1.d-10) then
dataCorrect=.false.
write (msg,*) "diffR8=", diffR8
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
endif
enddo
enddo
enddo
else
! dummy test
endif
call ESMF_Test((dataCorrect), name, failMsg, result, ESMF_SRCLINE)
call ESMF_ArraySync(arrayDup, rc=rc) ! prevent race condition with below
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
deallocate(localDeToDeMap)
deallocate(localArrayList)
deallocate(arrayToDistGridMap)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArraySync() for ESMF_PIN_DE_TO_SSI arrayDup "//&
"2D+1->2D Slice at k=2 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArraySync(arrayDup, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test for arrayDup with ESMF_PIN_DE_TO_SSI "//&
"2D+1->2D Slice at k=2 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(arrayDup, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate from Copy (value), ESMF_PIN_DE_TO_SSI "//&
"2D+1->2D Slice at k=3 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
arrayDup = ESMF_ArrayCreate(array, datacopyflag=ESMF_DATACOPY_VALUE, &
trailingUndistSlice=[3], rc=rc) ! create a slice
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet Fortran array pointer for ESMF_PIN_DE_TO_SSI "// &
"arrayDup 2D+1->2D Slice at k=3 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, farrayPtr=farrayPtr2D, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "Local Array lbounds=", lbound(farrayPtr2D)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
write (msg,*) "Local Array ubounds=", ubound(farrayPtr2D)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet rank, ssiLocalDeCount ESMF_PIN_DE_TO_SSI "//&
"arrayDup 2D+1->2D Slice at k=3 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, rank=rank, ssiLocalDeCount=ssiLocalDeCount, &
rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "ssiLocalDeCount=", ssiLocalDeCount
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
ssiLocalDeCount=1
rank=1
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
allocate(localDeToDeMap(ssiLocalDeCount))
allocate(localArrayList(ssiLocalDeCount))
allocate(arrayToDistGridMap(rank))
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Validate rank for ESMF_PIN_DE_TO_SSI arrayDup 2D+1->2D "//&
"Slice at k=3 Test"
write(failMsg, *) "Rank is wrong"
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rank==2), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "rank=", rank
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
! dummy test call
call ESMF_Test((.true.), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet localDeToDeMap, etc. ESMF_PIN_DE_TO_SSI arrayDup "//&
"2D+1->2D Slice at k=3 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, localDeToDeMap=localDeToDeMap, &
localarrayList=localArrayList, arrayToDistGridMap=arrayToDistGridMap, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "localDeToDeMap=", localDeToDeMap
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
write (msg,*) "arrayToDistGridMap=", arrayToDistGridMap
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Validate data in LocalArray for all DEs for "//&
"ESMF_PIN_DE_TO_SSI arrayDup 2D+1->2D Slice at k=3 Test"
write(failMsg, *) "Data not correct"
dataCorrect = .true. ! initialize
if (ssiSharedMemoryEnabled) then
k=3
do lde=1, ssiLocalDeCount
call ESMF_LocalArrayGet(localArrayList(lde), farrayPtr=farrayPtr2D, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
write (msg,*) "localDE=",lde-1," DE=", localDeToDeMap(lde), &
" data(",i,",",j,")=", farrayPtr2D(i,j)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
diffR8 = farrayPtr2D(i,j) - &
real(localDeToDeMap(lde)+5,ESMF_KIND_R8) &
* sin(real(i,ESMF_KIND_R8)) &
* sin(real(j,ESMF_KIND_R8)) &
* sin(real(k,ESMF_KIND_R8))
if (abs(diffR8) > 1.d-10) then
dataCorrect=.false.
write (msg,*) "diffR8=", diffR8
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
endif
enddo
enddo
enddo
else
! dummy test
endif
call ESMF_Test((dataCorrect), name, failMsg, result, ESMF_SRCLINE)
call ESMF_ArraySync(arrayDup, rc=rc) ! prevent race condition with below
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
deallocate(localDeToDeMap)
deallocate(localArrayList)
deallocate(arrayToDistGridMap)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArraySync() for ESMF_PIN_DE_TO_SSI arrayDup "//&
"2D+1->2D Slice at k=3 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArraySync(arrayDup, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test for arrayDup with ESMF_PIN_DE_TO_SSI "//&
"2D+1->2D Slice at k=3 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(arrayDup, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test for array with ESMF_PIN_DE_TO_SSI "//&
"2D+1 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Create test 2D+2 Array with ESMF_PIN_DE_TO_SSI"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(typekind=ESMF_TYPEKIND_R4, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, pinflag=ESMF_PIN_DE_TO_SSI, name="MyArray", &
undistLBound=[1,1], undistUBound=[3,4], rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMC_RC_INTNRL_BAD), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet Fortran array pointer for ESMF_PIN_DE_TO_SSI 2D+2 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, farrayPtr=farrayPtr4DR4, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "Local Array lbounds=", lbound(farrayPtr4DR4)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
write (msg,*) "Local Array ubounds=", ubound(farrayPtr4DR4)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet rank, ssiLocalDeCount ESMF_PIN_DE_TO_SSI 2D+2 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, rank=rank, ssiLocalDeCount=ssiLocalDeCount, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "ssiLocalDeCount=", ssiLocalDeCount
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
ssiLocalDeCount=1
rank=1
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
allocate(localDeToDeMap(ssiLocalDeCount))
allocate(localArrayList(ssiLocalDeCount))
allocate(arrayToDistGridMap(rank))
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Validate rank for ESMF_PIN_DE_TO_SSI 2D+2 Test"
write(failMsg, *) "Rank is wrong"
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rank==4), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "rank=", rank
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
! dummy test call
call ESMF_Test((.true.), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet localDeToDeMap, etc. ESMF_PIN_DE_TO_SSI 2D+2 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, localDeToDeMap=localDeToDeMap, &
localarrayList=localArrayList, arrayToDistGridMap=arrayToDistGridMap, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "localDeToDeMap=", localDeToDeMap
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
write (msg,*) "arrayToDistGridMap=", arrayToDistGridMap
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
! initialize the data on this PETs first localDE
if (ssiSharedMemoryEnabled) then
do l=lbound(farrayPtr4DR4,4), ubound(farrayPtr4DR4,4)
do k=lbound(farrayPtr4DR4,3), ubound(farrayPtr4DR4,3)
do j=lbound(farrayPtr4DR4,2), ubound(farrayPtr4DR4,2)
do i=lbound(farrayPtr4DR4,1), ubound(farrayPtr4DR4,1)
farrayPtr4DR4(i,j,k,l) = real(localDeToDeMap(1)+5,ESMF_KIND_R4) &
* sin(real(i,ESMF_KIND_R4)) &
* sin(real(j,ESMF_KIND_R4)) &
* sin(real(k,ESMF_KIND_R4)) &
* sin(real(l,ESMF_KIND_R4))
enddo
enddo
enddo
enddo
endif
!------------------------------------------------------------------------
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArraySync() for ESMF_PIN_DE_TO_SSI 2D+2 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArraySync(array, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "LocalArrayGet Fortran array pointer for next ssiLocalDe "//&
"for ESMF_PIN_DE_TO_SSI 2D+2 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
next = localPet + 2
if (next > ssiLocalDeCount) next = 1
call ESMF_LocalArrayGet(localArrayList(next), &
farrayPtr=farrayPtr4DR4, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "localDeToDeMap(next)=", localDeToDeMap(next)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
write (msg,*) "Local Array lbounds=", lbound(farrayPtr4DR4)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
write (msg,*) "Local Array ubounds=", ubound(farrayPtr4DR4)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Validate data in LocalArray for next ssiLocalDe for "//&
"ESMF_PIN_DE_TO_SSI 2D+2 Test"
write(failMsg, *) "Data not correct"
dataCorrect = .true. ! initialize
if (ssiSharedMemoryEnabled) then
do l=lbound(farrayPtr4DR4,4), ubound(farrayPtr4DR4,4)
do k=lbound(farrayPtr4DR4,3), ubound(farrayPtr4DR4,3)
do j=lbound(farrayPtr4DR4,2), ubound(farrayPtr4DR4,2)
do i=lbound(farrayPtr4DR4,1), ubound(farrayPtr4DR4,1)
write (msg,*) "data(",i,",",j,",",k,",",l,")=", farrayPtr4DR4(i,j,k,l)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
diffR4 = farrayPtr4DR4(i,j,k,l) - &
real(localDeToDeMap(next)+5,ESMF_KIND_R4) &
* sin(real(i,ESMF_KIND_R4)) &
* sin(real(j,ESMF_KIND_R4)) &
* sin(real(k,ESMF_KIND_R4)) &
* sin(real(l,ESMF_KIND_R4))
if (abs(diffR4) > 1.d-6) then
dataCorrect=.false.
write (msg,*) "diffR4=", diffR4
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
endif
enddo
enddo
enddo
enddo
else
! dummy test
endif
call ESMF_Test((dataCorrect), name, failMsg, result, ESMF_SRCLINE)
call ESMF_ArraySync(array, rc=rc) ! prevent race condition with below
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
deallocate(localDeToDeMap)
deallocate(localArrayList)
deallocate(arrayToDistGridMap)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate from Copy (REF), ESMF_PIN_DE_TO_SSI "//&
"2D+2->2D+1 Slice at l=1 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
arrayDup = ESMF_ArrayCreate(array, datacopyflag=ESMF_DATACOPY_REFERENCE, &
trailingUndistSlice=[1], rc=rc) ! create a slice
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet Fortran array pointer for ESMF_PIN_DE_TO_SSI "// &
"arrayDup 2D+2->2D+1 Slice at l=1 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, farrayPtr=farrayPtr3D, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "Local Array lbounds=", lbound(farrayPtr3D)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
write (msg,*) "Local Array ubounds=", ubound(farrayPtr3D)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet rank, ssiLocalDeCount ESMF_PIN_DE_TO_SSI "//&
"arrayDup 2D+2->2D+1 Slice at l=1 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, rank=rank, ssiLocalDeCount=ssiLocalDeCount, &
rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "ssiLocalDeCount=", ssiLocalDeCount
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
ssiLocalDeCount=1
rank=1
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
allocate(localDeToDeMap(ssiLocalDeCount))
allocate(localArrayList(ssiLocalDeCount))
allocate(arrayToDistGridMap(rank))
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Validate rank for ESMF_PIN_DE_TO_SSI arrayDup 2D+2->2D+1 "//&
"Slice at l=1 Test"
write(failMsg, *) "Rank is wrong"
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rank==3), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "rank=", rank
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
! dummy test call
call ESMF_Test((.true.), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet localDeToDeMap, etc. ESMF_PIN_DE_TO_SSI arrayDup "//&
"2D+2->2D+1 Slice at l=1 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(arrayDup, localDeToDeMap=localDeToDeMap, &
localarrayList=localArrayList, arrayToDistGridMap=arrayToDistGridMap, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
write (msg,*) "localDeToDeMap=", localDeToDeMap
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
write (msg,*) "arrayToDistGridMap=", arrayToDistGridMap
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Validate data in LocalArray for all DEs for "//&
"ESMF_PIN_DE_TO_SSI arrayDup 2D+2->2D+1 Slice at l=1 Test"
write(failMsg, *) "Data not correct"
dataCorrect = .true. ! initialize
if (ssiSharedMemoryEnabled) then
l=1
do lde=1, ssiLocalDeCount
call ESMF_LocalArrayGet(localArrayList(lde), farrayPtr=farrayPtr3D, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
do k=lbound(farrayPtr3D,3), ubound(farrayPtr3D,3)
do j=lbound(farrayPtr3D,2), ubound(farrayPtr3D,2)
do i=lbound(farrayPtr3D,1), ubound(farrayPtr3D,1)
write (msg,*) "localDE=",lde-1," DE=", localDeToDeMap(lde), &
" data(",i,",",j,",",k,")=", farrayPtr3D(i,j,k)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
diffR4 = farrayPtr3D(i,j,k) - &
real(localDeToDeMap(lde)+5,ESMF_KIND_R4) &
* sin(real(i,ESMF_KIND_R4)) &
* sin(real(j,ESMF_KIND_R4)) &
* sin(real(k,ESMF_KIND_R4)) &
* sin(real(l,ESMF_KIND_R4))
if (abs(diffR4) > 1.d-6) then
dataCorrect=.false.
write (msg,*) "diffR4=", diffR4
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
endif
enddo
enddo
enddo
enddo
else
! dummy test
endif
call ESMF_Test((dataCorrect), name, failMsg, result, ESMF_SRCLINE)
call ESMF_ArraySync(arrayDup, rc=rc) ! prevent race condition with below
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
deallocate(localDeToDeMap)
deallocate(localArrayList)
deallocate(arrayToDistGridMap)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArraySync() for ESMF_PIN_DE_TO_SSI arrayDup "//&
"2D+2->2D+1 Slice at l=1 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArraySync(arrayDup, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test for arrayDup with ESMF_PIN_DE_TO_SSI "//&
"2D+2->2D+1 Slice at l=1 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(arrayDup, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test for array with ESMF_PIN_DE_TO_SSI "//&
"2D+2 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
if (ssiSharedMemoryEnabled) then
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
else
write(failMsg, *) "Did not return the correct RC"
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
endif
!------------------------------------------------------------------------
! cleanup
call ESMF_DistGridDestroy(distgrid, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------
! preparations
distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/40/), rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate AssmdShape 1D ESMF_TYPEKIND_R8 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(farray=farray1D, distgrid=distgrid, &
indexflag=ESMF_INDEX_DELOCAL, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet Fortran array pointer, 1D ESMF_TYPEKIND_R8 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, farrayPtr=farrayPtr1D, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet w/ incompatible Fortran array pointer, 1D ESMF_TYPEKIND_R8 Test"
write(failMsg, *) "Did return ESMF_SUCCESS"
call ESMF_ArrayGet(array, farrayPtr=farrayPtr2D, rc=rc)
call ESMF_Test((rc.ne.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayPrint AssmdShape 1D ESMF_TYPEKIND_R8 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayPrint(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate AssmdShape 1D ESMF_TYPEKIND_R8 w/ negative computationalEdge widths Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(farray=farray1D, distgrid=distgrid, &
indexflag=ESMF_INDEX_DELOCAL, computationalEdgeLWidth=(/-1/), &
computationalEdgeUWidth=(/-1/), rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayPrint AssmdShape 1D ESMF_TYPEKIND_R8 w/ negative computationalEdge widths Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayPrint(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
! cleanup
call ESMF_DistGridDestroy(distgrid, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------
! preparations
distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/40,10/), &
regDecomp=(/petCount,1/), rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate AssmdShape 2D ESMF_TYPEKIND_R8 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(farray=farray2D, distgrid=distgrid, &
indexflag=ESMF_INDEX_DELOCAL, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet Fortran array pointer, 2D ESMF_TYPEKIND_R8 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, farrayPtr=farrayPtr2D, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet w/ incompatible Fortran array pointer, 2D ESMF_TYPEKIND_R8 Test"
write(failMsg, *) "Did return ESMF_SUCCESS"
call ESMF_ArrayGet(array, farrayPtr=farrayPtr3D, rc=rc)
call ESMF_Test((rc.ne.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
! cleanup
call ESMF_DistGridDestroy(distgrid, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------
! preparations
distgrid = ESMF_DistGridCreate(minIndex=(/1,1,1/), maxIndex=(/40,10,10/), &
regDecomp=(/petCount,1,1/), rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate AssmdShape 3D ESMF_TYPEKIND_R4 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(farray=farray3D, distgrid=distgrid, &
indexflag=ESMF_INDEX_DELOCAL, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet Fortran array pointer, 3D ESMF_TYPEKIND_R4 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, farrayPtr=farrayPtr3D, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
! cleanup
call ESMF_DistGridDestroy(distgrid, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------
! preparations
distgrid = ESMF_DistGridCreate(minIndex=(/1,1,1,1/), &
maxIndex=(/40,10,10,10/), regDecomp=(/petCount,1,1,1/), rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate AssmdShape 4D ESMF_TYPEKIND_I4 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(farray=farray4D, distgrid=distgrid, &
indexflag=ESMF_INDEX_DELOCAL, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet Fortran array pointer, 4D ESMF_TYPEKIND_I4 Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, farrayPtr=farrayPtr4D, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayCreate Allocate 2D with 4D DistGrid Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, &
! Dimensions 1 and 3 are replicated dimensions
distgridToArrayMap = [0,1,0,2], &
indexflag=ESMF_INDEX_GLOBAL, name="2D Array with 4D DistGrid", rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet replicatedDimCount Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, replicatedDimCount=replicatedDimCount, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Verify replicatedDimCount returned from Array with 2 replicated dims"
write(failMsg, *) "Incorrect replicatedDimCount"
call ESMF_Test(replicatedDimCount==2, name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayGet Fortran array pointer from Array with 2 replicated dims Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayGet(array, farrayPtr=farrayPtr2D, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
! cleanup
call ESMF_DistGridDestroy(distgrid, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------
! prepare a 2D DistGrid
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)
call ESMF_DistGridGet(distgrid, deCount=deCount, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
allocate(minIndexPDe(2,0:deCount-1), maxIndexPDe(2,0:deCount-1))
call ESMF_DistGridGet(distgrid, minIndexPDe=minIndexPDe, &
maxIndexPDe=maxIndexPDe, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
do de=0, deCount-1
write (msg,*) "DistGrid DE=",de," minIndexPDe=", minIndexPDe(:,de), &
" maxIndexPDe=", maxIndexPDe(:,de)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
enddo
deallocate(minIndexPDe, maxIndexPDe)
!------------------------------------------------------------------------
! prepare a 2D DistGrid with with extra edge elements
distgrid = ESMF_DistGridCreate(distgrid, &
firstExtra=(/1,2/), lastExtra=(/3,4/), rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_DistGridGet(distgrid, deCount=deCount, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
allocate(minIndexPDe(2,0:deCount-1), maxIndexPDe(2,0:deCount-1))
call ESMF_DistGridGet(distgrid, minIndexPDe=minIndexPDe, &
maxIndexPDe=maxIndexPDe, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
do de=0, deCount-1
write (msg,*) "DistGrid DE=",de," minIndexPDe=", minIndexPDe(:,de), &
" maxIndexPDe=", maxIndexPDe(:,de)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
enddo
deallocate(minIndexPDe, maxIndexPDe)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Create test Array for extra edge element test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(typekind=ESMF_TYPEKIND_R8, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, name="MyArray", rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
call ESMF_ArrayGet(array, localDeCount=localDeCount, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
allocate(exclusiveLBound(2,0:localDeCount-1))
allocate(exclusiveUBound(2,0:localDeCount-1))
allocate(localDeToDeMap(0:localDeCount-1))
call ESMF_ArrayGet(array, exclusiveLBound=exclusiveLBound, &
exclusiveUBound=exclusiveUBound, localDeToDeMap=localDeToDeMap, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
do lde=0, localDeCount-1
de = localDeToDeMap(lde)
write (msg,*) "Array DE=",de," exclusiveLBound=", exclusiveLBound(:,lde), &
" exclusiveUBound=", exclusiveUBound(:,lde)
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
enddo
deallocate(exclusiveLBound, exclusiveUBound)
deallocate(localDeToDeMap)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
! cleanup
call ESMF_DistGridDestroy(distgrid, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------
! prepare a 1D DistGrid with only a single DE, mapped to PET 0 by default
distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/4/), &
regDecomp=(/1/), rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Create Array on single DE DistGrid"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(typekind=ESMF_TYPEKIND_R8, distgrid=distgrid, &
indexflag=ESMF_INDEX_GLOBAL, name="MyArray", rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayPrint Array on single DE DistGrid"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayPrint(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
! prepare Fortran allocations on each PET to match DistGrid
if (localPet==0) then
allocate(farrayPtr1D(4))
else
allocate(farrayPtr1D(0))
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Create Array on single DE DistGrid with Fortran allocation"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(farray=farrayPtr1D, distgrid=distgrid, &
indexflag=ESMF_INDEX_DELOCAL, name="MyArray", rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
! cleanup
deallocate(farrayPtr1D)
call ESMF_DistGridDestroy(distgrid, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------
! prepare a 1D DistGrid with 4 DE, but only DE 0 holds data
distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/1/), &
regDecomp=(/4/), rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------
! prepare Fortran allocations on each PET to match DistGrid
if (localPet==0) then
allocate(farrayPtr1D(1))
else
allocate(farrayPtr1D(0))
endif
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Create Array on 4 DE DistGrid with only DE 0 elements, with Fortran allocation"
write(failMsg, *) "Did not return ESMF_SUCCESS"
array = ESMF_ArrayCreate(farray=farrayPtr1D, distgrid=distgrid, &
indexflag=ESMF_INDEX_DELOCAL, name="MyArray", rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "ArrayDestroy Test"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_ArrayDestroy(array, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
! cleanup
deallocate(farrayPtr1D)
call ESMF_DistGridDestroy(distgrid, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
10 continue
!------------------------------------------------------------------------
call ESMF_TestEnd(ESMF_SRCLINE) ! calls ESMF_Finalize() internally
!------------------------------------------------------------------------
end program ESMF_ArrayCreateGetUTest