program ESMF_InfoArrayUTest
use ESMF_TestMod
use ESMF
use ESMF_InfoMod
implicit none
!----------------------------------------------------------------------------
character(ESMF_MAXSTR) :: failMsg ! Test failure message
character(ESMF_MAXSTR) :: name ! Test name
integer :: rc, petCount, i, charcount, logical_count
! cumulative result: count failures; no failures equals "all pass"
integer :: result = 0
real(ESMF_KIND_R4), parameter :: tol = 1e-16 ! Tolerance for real tests
type(ESMF_Info) :: info
logical :: failed
logical, dimension(1) :: desired_logical_scalar_array
character(len=ESMF_MAXSTR), dimension(1) :: desired_char_scalar_array
character(len=22), dimension(5) :: desired_char
character(len=22), dimension(:), allocatable :: actual_char, scalar_char_test
logical, dimension(5) :: desired_logical
logical, dimension(:), allocatable :: actual_logical, scalar_logical_test
real(ESMF_KIND_R4), dimension(3) :: arr_R4 ! Desired array values
! Actual array values retrieved from info
real(ESMF_KIND_R4), dimension(:), allocatable :: arr_R4_get
real(ESMF_KIND_R4) :: value_R4_get
integer(ESMF_KIND_I4) :: arr_R4_get_count ! Array element count
real(ESMF_KIND_R8), dimension(3) :: arr_R8 ! Desired array values
! Actual array values retrieved from info
real(ESMF_KIND_R8), dimension(:), allocatable :: arr_R8_get
real(ESMF_KIND_R8) :: value_R8_get
integer(ESMF_KIND_I4) :: arr_R8_get_count ! Array element count
integer(ESMF_KIND_I4), dimension(3) :: arr_I4 ! Desired array values
! Actual array values retrieved from info
integer(ESMF_KIND_I4), dimension(:), allocatable :: arr_I4_get
integer(ESMF_KIND_I4) :: value_I4_get
integer(ESMF_KIND_I4) :: arr_I4_get_count ! Array element count
integer(ESMF_KIND_I8), dimension(3) :: arr_I8 ! Desired array values
! Actual array values retrieved from info
integer(ESMF_KIND_I8), dimension(:), allocatable :: arr_I8_get
integer(ESMF_KIND_I8) :: value_I8_get
integer(ESMF_KIND_I4) :: arr_I8_get_count ! Array element count
!----------------------------------------------------------------------------
call ESMF_TestStart(ESMF_SRCLINE, rc=rc) ! calls ESMF_Initialize() internally
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!----------------------------------------------------------------------------
! Create info object used by the array set/get tests
info = ESMF_InfoCreate(rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!----------------------------------------------------------------------------
!NEX_UTest
write(name, *) "ESMF_Info Array Setting/Getting R4"
write(failMsg, *) "Comparison to array get failed for R4"
failed = .false.
arr_R4(1:3) = (/ 1.0/3.0, 1.0/6.0, 1.0/12.0 /)
call ESMF_InfoSet(info, "the-key-R4", arr_R4, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_InfoGetAlloc(info, "the-key-R4", arr_R4_get, &
itemcount=arr_R4_get_count, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
do i=1, 3
if (ABS(arr_R4(i) - arr_R4_get(i)) > tol) then
failed = .true.
exit
end if
end do
deallocate(arr_R4_get)
call ESMF_Test((.not. failed), name, failMsg, result, ESMF_SRCLINE)
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!NEX_UTest
write(name, *) "ESMF_Info Array Setting/Getting R8"
write(failMsg, *) "Comparison to array get failed for R8"
failed = .false.
arr_R8(1:3) = (/ 1.0/3.0, 1.0/6.0, 1.0/12.0 /)
call ESMF_InfoSet(info, "the-key-R8", arr_R8, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_InfoGetAlloc(info, "the-key-R8", arr_R8_get, &
itemcount=arr_R8_get_count, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
do i=1, 3
if (ABS(arr_R8(i) - arr_R8_get(i)) > tol) then
failed = .true.
exit
end if
end do
deallocate(arr_R8_get)
call ESMF_Test((.not. failed), name, failMsg, result, ESMF_SRCLINE)
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!NEX_UTest
write(name, *) "ESMF_Info Array Setting/Getting I4"
write(failMsg, *) "Comparison to array get failed for I4"
failed = .false.
arr_I4(1:3) = (/ 123, 456, 789 /)
call ESMF_InfoSet(info, "the-key-I4", arr_I4, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_InfoGetAlloc(info, "the-key-I4", arr_I4_get, &
itemcount=arr_I4_get_count, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
do i=1, 3
if (arr_I4(i) /= arr_I4_get(i)) then
failed = .true.
exit
end if
end do
deallocate(arr_I4_get)
call ESMF_Test((.not. failed), name, failMsg, result, ESMF_SRCLINE)
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!NEX_UTest
write(name, *) "ESMF_Info Array Setting/Getting I8"
write(failMsg, *) "Comparison to array get failed for I8"
failed = .false.
arr_I8(1:3) = (/ 123, 456, 789 /)
call ESMF_InfoSet(info, "the-key-I8", arr_I8, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_InfoGetAlloc(info, "the-key-I8", arr_I8_get, &
itemcount=arr_I8_get_count, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
do i=1, 3
if (arr_I8(i) /= arr_I8_get(i)) then
failed = .true.
exit
end if
end do
deallocate(arr_I8_get)
call ESMF_Test((.not. failed), name, failMsg, result, ESMF_SRCLINE)
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!NEX_UTest
write(name, *) "ESMF_Info Array Setting/Getting Index R4"
write(failMsg, *) "Comparison to array index get failed for R4"
failed = .false.
do i=1, 3
call ESMF_InfoGet(info, "the-key-R4", value_R4_get, idx=i, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
if (ABS(arr_R4(i) - value_R4_get) > tol) then
failed = .true.
exit
end if
end do
call ESMF_Test((.not. failed), name, failMsg, result, ESMF_SRCLINE)
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!NEX_UTest
write(name, *) "ESMF_Info Array Setting/Getting Index R8"
write(failMsg, *) "Comparison to array index get failed for R8"
failed = .false.
do i=1, 3
call ESMF_InfoGet(info, "the-key-R8", value_R8_get, idx=i, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
if (ABS(arr_R8(i) - value_R8_get) > tol) then
failed = .true.
exit
end if
end do
call ESMF_Test((.not. failed), name, failMsg, result, ESMF_SRCLINE)
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!NEX_UTest
write(name, *) "ESMF_Info Array Setting/Getting Index I4"
write(failMsg, *) "Comparison to array index get failed for I4"
failed = .false.
do i=1, 3
call ESMF_InfoGet(info, "the-key-I4", value_I4_get, idx=i, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
if (arr_I4(i) /= value_I4_get) then
failed = .true.
exit
end if
end do
call ESMF_Test((.not. failed), name, failMsg, result, ESMF_SRCLINE)
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!NEX_UTest
write(name, *) "ESMF_Info Array Setting/Getting Index I8"
write(failMsg, *) "Comparison to array index get failed for I8"
failed = .false.
do i=1, 3
call ESMF_InfoGet(info, "the-key-I8", value_I8_get, idx=i, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
if (arr_I8(i) /= value_I8_get) then
failed = .true.
exit
end if
end do
call ESMF_Test((.not. failed), name, failMsg, result, ESMF_SRCLINE)
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!NEX_UTest
write(name, *) "ESMF_Info Array Setting/Getting Logical"
write(failMsg, *) "Info logical array operation failed"
failed = .false.
desired_logical(1) = .true.
desired_logical(2) = .false.
desired_logical(3) = .false.
desired_logical(4) = .true.
desired_logical(5) = .true.
call ESMF_InfoSet(info, "logicalkey", desired_logical, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!call ESMF_InfoPrint(info, rc=rc)
!if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_InfoGetAlloc(info, "logicalkey", actual_logical, itemcount=logical_count, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
do i=1,logical_count
if (desired_logical(i) .neqv. actual_logical(i)) then
failed = .true.
exit
endif
enddo
deallocate(actual_logical)
call ESMF_Test((.not. failed), name, failMsg, result, ESMF_SRCLINE)
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!NEX_UTest
write(name, *) "ESMF_Info Array Setting/Getting Character"
write(failMsg, *) "Info character array operation failed"
failed = .false.
desired_char(1) = "my"
desired_char(2) = "country"
desired_char(3) = ""
desired_char(4) = "sweet land"
desired_char(5) = "of the liberty"
call ESMF_InfoSet(info, "charkey", desired_char, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!call ESMF_InfoPrint(info, rc=rc)
!if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_InfoGetAlloc(info, "charkey", actual_char, itemcount=charcount, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
do i=1,charcount
if (desired_char(i) /= actual_char(i)) then
failed = .true.
exit
endif
enddo
deallocate(actual_char)
call ESMF_Test((.not. failed), name, failMsg, result, ESMF_SRCLINE)
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!NEX_UTest
write(name, *) "ESMF_Info Array Bad Set-By-Index"
write(failMsg, *) "Info set by index error not handled"
failed = .false.
call ESMF_InfoSet(info, "logicalkey", .false., idx=55, rc=rc)
call ESMF_Test((rc/=ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!NEX_UTest
write(name, *) "ESMF_Info Array Bad Set-By-Index Type"
write(failMsg, *) "Info set by index error not handled"
failed = .false.
call ESMF_InfoSet(info, "logicalkey", 55, idx=1, rc=rc)
call ESMF_Test((rc==ESMC_RC_OBJ_BAD), name, failMsg, result, ESMF_SRCLINE)
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!NEX_UTest
write(name, *) "ESMF_Info Array Bad Key Overload Type"
write(failMsg, *) "Info set error not handled"
failed = .false.
call ESMF_InfoSet(info, "charkey", 55, rc=rc)
!if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_Test((rc==ESMC_RC_ARG_BAD), name, failMsg, result, ESMF_SRCLINE)
!call ESMF_InfoPrint(info, rc=rc)
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!NEX_UTest
write(name, *) "ESMF_Info Get Array when Storage is Scalar"
write(failMsg, *) "Did not handle array-to-scalar validation"
rc = ESMF_FAILURE
failed = .false.
call ESMF_InfoSet(info, "foo-is-scalar", .true., rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_InfoGetAlloc(info, "foo-is-scalar", scalar_logical_test, scalarToArray=.false., rc=rc)
call ESMF_Test(rc==ESMF_RC_ATTR_WRONGTYPE, name, failMsg, result, ESMF_SRCLINE)
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!NEX_UTest
write(name, *) "ESMF_Info Get Array when Storage is Scalar for Character"
write(failMsg, *) "Did not handle array-to-scalar validation for character"
rc = ESMF_FAILURE
failed = .false.
call ESMF_InfoSet(info, "foo-is-ch", "im a char yeah", rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_InfoGet(info, "foo-is-ch", scalar_char_test, scalarToArray=.false., rc=rc)
call ESMF_Test(rc==ESMF_RC_ATTR_WRONGTYPE, name, failMsg, result, ESMF_SRCLINE)
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!NEX_UTest
write(name, *) "ESMF_Info Get Array when Storage is NULL"
write(failMsg, *) "Did not handle array-to-null validation"
rc = ESMF_FAILURE
failed = .false.
call ESMF_InfoSetNULL(info, "foo-is-null", rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_InfoGetAlloc(info, "foo-is-null", scalar_logical_test, rc=rc)
call ESMF_Test(rc==ESMF_RC_ATTR_WRONGTYPE, name, failMsg, result, ESMF_SRCLINE)
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!NEX_UTest
write(name, *) "ESMF_Info Get Array with Scalar Conversion Character"
write(failMsg, *) "Did not handle array-to-scalar conversion character"
rc = ESMF_FAILURE
failed = .false.
call ESMF_InfoSet(info, "foo-array-to-scalar-ch", "char scalar value1", rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_InfoGet(info, "foo-array-to-scalar-ch", desired_char_scalar_array, scalarToArray=.true., rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_Test(trim(desired_char_scalar_array(1))=="char scalar value1", name, failMsg, result, ESMF_SRCLINE)
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!NEX_UTest
write(name, *) "ESMF_Info Get Array with Scalar Conversion Logical"
write(failMsg, *) "Did not handle array-to-scalar conversion logical"
rc = ESMF_FAILURE
failed = .false.
call ESMF_InfoSet(info, "foo-array-to-scalar-lg", .true., rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_InfoGet(info, "foo-array-to-scalar-lg", desired_logical_scalar_array, scalarToArray=.true., rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_Test(desired_logical_scalar_array(1), name, failMsg, result, ESMF_SRCLINE)
!----------------------------------------------------------------------------
! Destroy the info object used by the array set/get tests
call ESMF_InfoDestroy(info, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!----------------------------------------------------------------------------
call ESMF_TestEnd(ESMF_SRCLINE) ! calls ESMF_Finalize() internally
!----------------------------------------------------------------------------
end program ESMF_InfoArrayUTest