program ESMF_VMUTest
!------------------------------------------------------------------------------
!==============================================================================
!BOP
! !PROGRAM: ESMF_VMTest - This unit test file verifies VM methods.
!
! !DESCRIPTION:
!
! The code in this file drives F90 VM unit tests.
! The companion file ESMF\_VM.F90 contains the definitions for the
! VM methods.
!
!-----------------------------------------------------------------------------
! !USES:
use ESMF_TestMod ! test methods
use ESMF
use ESMF_VMSubrs ! VM specific subroutines
implicit none
!------------------------------------------------------------------------------
! The following line turns the CVS identifier string into a printable variable.
character(*), parameter :: version = &
'$Id$'
!------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
! 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.
!-------------------------------------------------------------------------------
type(ESMF_VMId), allocatable :: vmid1(:), vmid2(:)
integer :: id_value
character :: key_value
type(ESMF_Grid) :: grid
type(ESMF_Base) :: base
integer :: id_temp, ssiCount, ssiMinPetCount, ssiMaxPetCount
type(ESMF_VMId) :: vmid_temp
type(ESMF_Log) :: log
character(len=80) :: msg
logical :: tf
call ESMF_TestStart(ESMF_SRCLINE, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------
!NEX_UTest
write(failMsg, *) "Did not return ESMF_RC_OBJ_NOT_CREATED"
write(name, *) "VM Get before initialization Test"
call ESMF_VMGet(vm, petCount=npets, rc=rc)
call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest
write(failMsg, *) "Returned ESMF_SUCCESS"
write(name, *) "VM validate Test before valid VM"
call ESMF_VMValidate(vm, rc=rc)
call ESMF_Test((rc.ne.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "VM Get Global Test"
call ESMF_VMGetGlobal(vm, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "VM Get Test"
call ESMF_VMGet(vm, petCount=npets, ssiCount=ssiCount, &
ssiMinPetCount=ssiMinPetCount, ssiMaxPetCount=ssiMaxPetCount, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
if (npets .ne. 1 .and. npets .ne. 4) then
print *, 'PET count must be 1 or 4, npets =', npets
call ESMF_Finalize (endflag=ESMF_END_ABORT)
end if
write(msg,*) "petCount=", npets, " ssiCount=", ssiCount
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
write(msg,*) "ssiMinPetCount=", ssiMinPetCount, &
" ssiMaxPetCount=", ssiMaxPetCount
call ESMF_LogWrite(msg, ESMF_LOGMSG_INFO, rc=rc)
!------------------------------------------------------------------------
!NEX_UTest
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "VM print Test"
call ESMF_VMPrint(vm, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest
write(name, *) "VMLog w/ prefix"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_VMLog(vm, prefix="TestVMLog: ", rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest
write(name, *) "VMLogSystem w/ prefix"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_VMLogSystem(prefix="TestVMLogSystem: ", rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!NEX_UTest
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "VM validate Test"
call ESMF_VMValidate(vm, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#ifdef ESMF_TESTEXHAUSTIVE
!------------------------------------------------------------------------
!EX_UTest
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "VM Get Test"
call ESMF_VMGet(vm, localPet=localPet, petCount=npets, rc=rc)
call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
! allocate data arrays
nsize = 2
allocate(array1(nsize))
allocate(array4(nsize))
allocate(farray4(nsize))
allocate(f4array4(nsize))
allocate(farray1(nsize))
allocate(f4array1(nsize))
allocate(array5(nsize))
allocate(farray5(nsize))
allocate(f4array5(nsize))
allocate(array3(nsize))
allocate(farray3(nsize))
allocate(f4array3(nsize))
allocate(array3_soln(nsize))
allocate(farray3_soln(nsize))
allocate(f4array3_soln(nsize))
! prepare data array1, farray1, f4array1
do i=1, nsize
array1(i) = localPet * 100 + i
farray1(i)= real( array1(i) , ESMF_KIND_R8)
f4array1(i)=real(farray1(i))
enddo
! Populate array2
allocate(array2(nsize,npets))
allocate(farray2(nsize,npets))
allocate(f4array2(nsize,npets))
do j=1, npets
do i=1, nsize
array2(i,j) = (j-1) * 100 + i
farray2(i,j) = real( array2(i,j) , ESMF_KIND_R8)
f4array2(i,j) = real(farray2(i,j))
enddo
enddo
!------------------------------------------------------------------------
rootPet = 0
call test_vm_current
call test_vm_operators
call test_vm_time
call test_Reduce_sum
call test_AllFullReduce_sum
call test_AllReduce_sum
call test_Reduce_min
call test_AllFullReduce_min
call test_AllReduce_min
call test_Reduce_max
call test_AllFullReduce_max
call test_AllReduce_max
!------------------------------------------------------------------------
! deallocate data arrays
deallocate(array1)
deallocate(array4)
deallocate(farray4)
deallocate(f4array4)
deallocate(farray1)
deallocate(f4array1)
deallocate(array5)
deallocate(farray5)
deallocate(f4array5)
deallocate(array3)
deallocate(farray3)
deallocate(f4array3)
deallocate(array3_soln)
deallocate(farray3_soln)
deallocate(f4array3_soln)
deallocate(array2)
deallocate(farray2)
deallocate(f4array2)
!------------------------------------------------------------------------
! VMId tests
!------------------------------------------------------------------------
!EX_UTest
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "VMId Create vmid1 Test"
allocate (vmid1(1))
call ESMF_VMIdCreate (vmid1, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!EX_UTest
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "VMId Create vmid2 Test"
allocate (vmid2(1))
call ESMF_VMIdCreate (vmid2, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!EX_UTest
write(failMsg, *) "Bad comparison result"
write(name, *) "VMId Compare Test"
tf = ESMF_VMIdCompare (vmid1(1), vmid2(1), rc=rc)
call ESMF_Test(tf, name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!EX_UTest
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "VMId Set test values Test"
call c_ESMCI_VMIdSet (vmid1(1), 1234, achar (123), rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!EX_UTest
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "VMId print test values Test"
call ESMF_VMIdPrint (vmid1(1), rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!EX_UTest
write(failMsg, *) "Bad comparison result"
write(name, *) "VMId Compare Test"
tf = ESMF_VMIdCompare (vmid1(1), vmid2(1))
call ESMF_Test(.not. tf, name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!EX_UTest
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "VMId Set test values Test"
call ESMF_VMIdCopy (dest=vmid2, source=vmid1, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!EX_UTest
write(failMsg, *) "Bad comparison result"
write(name, *) "VMId Compare Test"
tf = ESMF_VMIdCompare (vmid1(1), vmid2(1))
call ESMF_Test(tf, name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!EX_UTest
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "VMId Get test values Test"
call c_ESMCI_VMIdGet (vmid2(1), id_value, key_value, rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!EX_UTest
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "VMId id_value Test"
call ESMF_Test(id_value == 1234, name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!EX_UTest
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "VMId key_value Test"
call ESMF_Test(key_value == achar (123), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!EX_UTest
write(failMsg, *) "Destroy #1 failed"
write(name, *) "VMId destroy #1 Test"
call ESMF_VMIdDestroy (vmid1, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!EX_UTest
write(failMsg, *) "Destroy #2 failed"
write(name, *) "VMId destroy #2 Test"
call ESMF_VMIdDestroy (vmid2, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
deallocate (vmid1, vmid2)
! Test accessing an object by its id and vmid
!------------------------------------------------------------------------
!EX_UTest
! Create Grid object.
! WARNING: This is testing an INTERNAL method. It is NOT
! part of the supported ESMF user API!
write(name, *) "Create a Grid object"
write(failMsg, *) 'Did not return ESMF_SUCCESS'
grid = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=(/10,20/), &
regDecomp=(/2,2/), name="Grid", rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), &
name, failMsg, result, ESMF_SRCLINE)
call ESMF_GridPrint (grid, rc=rc)
!------------------------------------------------------------------------
!EX_UTest
! Access Grids Base ID.
! WARNING: This is testing an INTERNAL method. It is NOT
! part of the supported ESMF user API!
write(name, *) "Access Base of Grid"
write(failMsg, *) 'Did not return ESMF_SUCCESS'
call c_esmc_getid (grid, id_temp, rc)
call ESMF_Test((rc == ESMF_SUCCESS), &
name, failMsg, result, ESMF_SRCLINE)
print *, 'Grids Base ID =', id_temp
!------------------------------------------------------------------------
!EX_UTest
! Create a temporary VMId.
! WARNING: This is testing an INTERNAL method. It is NOT
! part of the supported ESMF user API!
write(name, *) "Create temporary VMId"
write(failMsg, *) 'Did not return ESMF_SUCCESS'
call ESMF_VMIdCreate (vmid_temp, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), &
name, failMsg, result, ESMF_SRCLINE)
call ESMF_VMIdPrint (vmid_temp, rc=rc)
!------------------------------------------------------------------------
!EX_UTest
! Destroy a temporary VMId.
! WARNING: This is testing an INTERNAL method. It is NOT
! part of the supported ESMF user API!
write(name, *) "Destroy VMId"
write(failMsg, *) 'Did not return ESMF_SUCCESS'
call ESMF_VMIdDestroy (vmid_temp, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), &
name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!EX_UTest
! Access Grids Base VMId.
! WARNING: This is testing an INTERNAL method. It is NOT
! part of the supported ESMF user API!
write(name, *) "Access Base ID and VMId"
write(failMsg, *) 'Did not return ESMF_SUCCESS'
call c_esmc_getvmid (grid, vmid_temp, rc)
call ESMF_Test((rc == ESMF_SUCCESS), &
name, failMsg, result, ESMF_SRCLINE)
call ESMF_VMIdPrint (vmid_temp, rc=rc)
!------------------------------------------------------------------------
!EX_UTest
! ESMF_VMLogMemInfo()
! WARNING: This is testing an INTERNAL method. It is NOT
! part of the supported ESMF user API!
write(name, *) "Write VMLogMemInfo into the default log w/o prefix"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_VMLogMemInfo(rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!EX_UTest
! ESMF_VMLogMemInfo()
! WARNING: This is testing an INTERNAL method. It is NOT
! part of the supported ESMF user API!
write(name, *) "Write VMLogMemInfo into the default log w/ prefix"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_VMLogMemInfo(prefix="TestPrefix", rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
call ESMF_LogOpen(log, filename="vmLogMemInfo.log", appendflag=.false., &
rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------
!EX_UTest
! ESMF_VMLogMemInfo()
! WARNING: This is testing an INTERNAL method. It is NOT
! part of the supported ESMF user API!
write(name, *) "Write VMLogMemInfo into custom log w/o prefix"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_VMLogMemInfo(log=log, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------
!EX_UTest
! ESMF_VMLogMemInfo()
! WARNING: This is testing an INTERNAL method. It is NOT
! part of the supported ESMF user API!
write(name, *) "Write VMLogMemInfo into custom log w/ prefix"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_VMLogMemInfo(prefix="TestPrefix", log=log, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
call ESMF_LogClose(log, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
#endif
call ESMF_TestEnd(ESMF_SRCLINE)
end program ESMF_VMUTest