! $Id$
!
! Earth System Modeling Framework
! Copyright (c) 2002-2024, University Corporation for Atmospheric Research,
! Massachusetts Institute of Technology, Geophysical Fluid Dynamics
! Laboratory, University of Michigan, National Centers for Environmental
! Prediction, Los Alamos National Laboratory, Argonne National Laboratory,
! NASA Goddard Space Flight Center.
! Licensed under the University of Illinois-NCSA License.
!
!==============================================================================
!
program ESMF_ArrayScatterUTest

!------------------------------------------------------------------------------
 
#include "ESMF_Macros.inc"

!==============================================================================
!BOP
! !PROGRAM: ESMF_ArrayScatterUTest - This unit test file tests ArrayScatter()
! !DESCRIPTION:
!
! The code in this file drives Fortran ArrayScatter unit tests.
! The companion file ESMF\_Array.F90 contains the definitions for the
! Array methods.
!
!-----------------------------------------------------------------------------
! !USES:
  use ESMF_TestMod     ! test methods
  use ESMF

  implicit none

!------------------------------------------------------------------------------
! The following line turns the CVS identifier string into a printable variable.
  character(*), parameter :: version = &
    '$Id$'
!------------------------------------------------------------------------------

  ! cumulative result: count failures; no failures equals "all pass"
  integer :: result = 0

  ! individual test result code
  integer :: rc

  ! individual test failure message
  character(ESMF_MAXSTR) :: failMsg
  character(ESMF_MAXSTR) :: name

  !LOCAL VARIABLES:
  real(ESMF_KIND_R8), parameter :: min_R8 = 1.d-10
  real(ESMF_KIND_R4), parameter :: min_R4 = 1.e-4
  type(ESMF_VM):: vm
  integer:: petCount, localPet, i, j
  type(ESMF_ArraySpec)  :: arrayspec
  type(ESMF_DistGrid)   :: distgrid
  type(ESMF_Array)      :: array
  real(ESMF_KIND_R8), pointer :: farrayPtr(:,:)     ! matching Fortran array pointer
  real(ESMF_KIND_R8), allocatable :: srcfarray(:,:)
  real(ESMF_KIND_R8), allocatable :: srcfarray_save(:,:)
  real(ESMF_KIND_R8):: value
  real(ESMF_KIND_R4), pointer :: farrayPtr_R4(:,:)     ! matching Fortran array pointer
  real(ESMF_KIND_R4), allocatable :: srcfarray_R4(:,:)
  real(ESMF_KIND_R4), allocatable :: srcfarray_R4_save(:,:)
  real(ESMF_KIND_R4):: value_R4
#ifdef ESMF_TESTEXHAUSTIVE
  integer:: k, kk, ii, jj, dimExtent1, dimExtent2
  integer, allocatable:: indexList1(:), indexList2(:)
  real(ESMF_KIND_R8), pointer :: farrayPtr3d(:,:,:) ! matching Fortran array pointer
  real(ESMF_KIND_R8), allocatable :: srcfarray3d(:,:,:)
  real(ESMF_KIND_R8), allocatable :: srcfarray3d_save(:,:,:)
  integer:: exclusiveLBound(2,1), exclusiveUBound(2,1)
#endif

!-------------------------------------------------------------------------------
! The unit tests are divided into Sanity and Exhaustive. The Sanity tests are
! always run. When the environment variable, EXHAUSTIVE, is set to ON then 
! the EXHAUSTIVE and sanity tests both run. If the EXHAUSTIVE variable is set
! to OFF, then only the sanity unit tests.
! Special strings (Non-exhaustive and exhaustive) have been
! added to allow a script to count the number and types of unit tests.
!------------------------------------------------------------------------------- 

  !------------------------------------------------------------------------
  call ESMF_TestStart(ESMF_SRCLINE, rc=rc)  ! calls ESMF_Initialize() internally
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  !------------------------------------------------------------------------
  
  !------------------------------------------------------------------------
  ! preparations
  call ESMF_VMGetGlobal(vm, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  
  !------------------------------------------------------------------------
  ! this unit test requires to be run on exactly 4 PETs
  if (petCount /= 4) goto 10
  
print *, min_R4, min_R8
  
  !------------------------------------------------------------------------
  ! preparations
  call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R8, rank=2, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/15,23/), &
    regDecomp=(/2,2/), rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, &
    indexflag=ESMF_INDEX_GLOBAL, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!call ESMF_ArrayPrint(array)
  call ESMF_ArrayGet(array, farrayPtr=farrayPtr, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  farrayPtr = real(localPet,ESMF_KIND_R8)  ! initialize each DE-local data chunk of Array
!print *, "farrayPtr:", farrayPtr
  ! prepare srcfarray on all PETs -> serves as ref. in comparison after scatter
  allocate(srcfarray(1:15, 1:23))
  allocate(srcfarray_save(1:15, 1:23))
  do j=1, 23
    do i=1, 15
      srcfarray(i,j) = 123._ESMF_KIND_R8*sin(real(i,ESMF_KIND_R8)) +  &
                       321._ESMF_KIND_R8*cos(real(j,ESMF_KIND_R8))
      srcfarray_save(i,j) = srcfarray(i,j)
    enddo
  enddo
!print *, "srcfarray:", srcfarray

  !------------------------------------------------------------------------
  !NEX_UTest_Multi_Proc_Only
  write(name, *) "2D ESMF_TYPEKIND_R8 ArrayScatter() w/ incompatible Fortran Array (typekind) Test"
  write(failMsg, *) "Did return ESMF_SUCCESS"
  allocate (srcfarray_R4(1,1))
  call ESMF_ArrayScatter(array, srcfarray_R4, rootPet=0, rc=rc)
  call ESMF_Test((rc.ne.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
  deallocate (srcfarray_R4)
  
#ifdef ESMF_TESTEXHAUSTIVE
  !------------------------------------------------------------------------
  !EX_UTest_Multi_Proc_Only
  write(name, *) "2D ESMF_TYPEKIND_R8 ArrayScatter() w/ incompatible Fortran Array (rank) Test"
  write(failMsg, *) "Did return ESMF_SUCCESS"
  allocate (srcfarray3d(1,1,1))
  call ESMF_ArrayScatter(array, srcfarray3d, rootPet=0, rc=rc)
  call ESMF_Test((rc.ne.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
  deallocate (srcfarray3d)
#endif

  !------------------------------------------------------------------------
  !NEX_UTest_Multi_Proc_Only
  write(name, *) "2D ESMF_TYPEKIND_R8 ArrayScatter() Test"
  write(failMsg, *) "Did not return ESMF_SUCCESS"
  call ESMF_ArrayScatter(array, srcfarray, rootPet=0, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
  
  !------------------------------------------------------------------------
  !NEX_UTest_Multi_Proc_Only
  ! Verify srcfarray data after scatter
  write(name, *) "Verifying srcfarray data after 2D ESMF_TYPEKIND_R8 ArrayScatter() Test"
  write(failMsg, *) "Source data was modified."
  rc = ESMF_SUCCESS
  do j=1, 23
    do i=1, 15
      value = 123._ESMF_KIND_R8*sin(real(i,ESMF_KIND_R8)) +  &
               321._ESMF_KIND_R8*cos(real(j,ESMF_KIND_R8))
      value = srcfarray(i,j) - srcfarray_save(i,j)
      if (abs(value) > min_R8) then
        print *, "Found mismatch value", i, j, value
        rc = ESMF_FAILURE
      endif
   enddo
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX_UTest_Multi_Proc_Only
  ! Verify Array data after scatter
  write(name, *) "Verifying destination Array data after 2D ESMF_TYPEKIND_R8 ArrayScatter() Test"
  write(failMsg, *) "Array data wrong."
  rc = ESMF_SUCCESS
  do j=lbound(farrayPtr,2), ubound(farrayPtr,2)
    do i=lbound(farrayPtr,1), ubound(farrayPtr,1)
      if (abs(farrayPtr(i,j) - srcfarray(i,j)) > min_R8) then
        print *, "Found mismatch value", i, j, &
          abs(farrayPtr(i,j) - srcfarray(i,j))
        rc = ESMF_FAILURE
      endif
    enddo
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
  
  !------------------------------------------------------------------------
  ! cleanup  
  call ESMF_ArrayDestroy(array, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  call ESMF_DistGridDestroy(distgrid, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  deallocate(srcfarray)
  deallocate(srcfarray_save)
  
  !------------------------------------------------------------------------
  !------------------------------------------------------------------------

  !------------------------------------------------------------------------
  ! preparations for same test as above but omit farray on PETs not root
  call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R8, rank=2, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/15,23/), &
    regDecomp=(/2,2/), rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, &
    indexflag=ESMF_INDEX_GLOBAL, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!call ESMF_ArrayPrint(array)
  call ESMF_ArrayGet(array, farrayPtr=farrayPtr, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  farrayPtr = real(localPet,ESMF_KIND_R8)  ! initialize each DE-local data chunk of Array
!print *, "farrayPtr:", farrayPtr
  ! prepare srcfarray on all PETs -> serves as ref. in comparison after scatter
  allocate(srcfarray(1:15, 1:23))
  allocate(srcfarray_save(1:15, 1:23))
  do j=1, 23
    do i=1, 15
      srcfarray(i,j) = 123._ESMF_KIND_R8*sin(real(i,ESMF_KIND_R8)) +  &
                       321._ESMF_KIND_R8*cos(real(j,ESMF_KIND_R8))
      srcfarray_save(i,j) = srcfarray(i,j)
    enddo
  enddo
!print *, "srcfarray:", srcfarray

  !------------------------------------------------------------------------
  !NEX_UTest_Multi_Proc_Only
  write(name, *) "2D ESMF_TYPEKIND_R8 ArrayScatter() with omitted srcfarray Test"
  write(failMsg, *) "Did not return ESMF_SUCCESS"
  if (localPet==0) then
    call ESMF_ArrayScatter(array, farray=srcfarray, rootPet=0, rc=rc)
  else
    call ESMF_ArrayScatter(array, rootPet=0, rc=rc)
  endif
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
  
  !------------------------------------------------------------------------
  !NEX_UTest_Multi_Proc_Only
  ! Verify srcfarray data after scatter
  write(name, *) "Verifying srcfarray data after 2D ESMF_TYPEKIND_R8 ArrayScatter() ",&
    "with omitted srcfarray Test"
  write(failMsg, *) "Source data was modified."
  rc = ESMF_SUCCESS
  do j=1, 23
    do i=1, 15
      value = srcfarray(i,j) - srcfarray_save(i,j)
      if (abs(value) > min_R8) then
        print *, "Found mismatch value", i, j, value
        rc = ESMF_FAILURE
      endif
   enddo
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX_UTest_Multi_Proc_Only
  ! Verify Array data after scatter
  write(name, *) "Verifying destination Array data after 2D ESMF_TYPEKIND_R8 ",&
    "ArrayScatter() with omitted srcfarray Test"
  write(failMsg, *) "Array data wrong."
  rc = ESMF_SUCCESS
  do j=lbound(farrayPtr,2), ubound(farrayPtr,2)
    do i=lbound(farrayPtr,1), ubound(farrayPtr,1)
      if (abs(farrayPtr(i,j) - srcfarray(i,j)) > min_R8) then
        print *, "Found mismatch value", i, j, &
          abs(farrayPtr(i,j) - srcfarray(i,j))
        rc = ESMF_FAILURE
      endif
    enddo
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
  
  !------------------------------------------------------------------------
  ! cleanup  
  call ESMF_ArrayDestroy(array, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  call ESMF_DistGridDestroy(distgrid, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  deallocate(srcfarray)
  deallocate(srcfarray_save)
  
  !------------------------------------------------------------------------
  !------------------------------------------------------------------------

  !------------------------------------------------------------------------
  ! preparations for same test as above but with ESMF_TYPEKIND_R4
  call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R4, rank=2, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/15,23/), &
    regDecomp=(/2,2/), rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, &
    indexflag=ESMF_INDEX_GLOBAL, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!call ESMF_ArrayPrint(array)
  call ESMF_ArrayGet(array, farrayPtr=farrayPtr_R4, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  farrayPtr_R4 = real(localPet,ESMF_KIND_R4)  ! initialize each DE-local data chunk of Array
!print *, "farrayPtr_R4:", farrayPtr_R4
  ! prepare srcfarray_R4 on all PETs -> serves as ref. in comparison after scatter
  allocate(srcfarray_R4(1:15, 1:23))
  allocate(srcfarray_R4_save(1:15, 1:23))
  do j=1, 23
    do i=1, 15
      srcfarray_R4(i,j) = 123._ESMF_KIND_R4*sin(real(i,ESMF_KIND_R4)) +  &
                       321._ESMF_KIND_R4*cos(real(j,ESMF_KIND_R4))
      srcfarray_R4_save(i,j) = srcfarray_R4(i,j)
    enddo
  enddo
!print *, "srcfarray_R4:", srcfarray_R4
  !------------------------------------------------------------------------
  !NEX_UTest_Multi_Proc_Only
  write(name, *) "2D ESMF_TYPEKIND_R4 ArrayScatter() Test"
  write(failMsg, *) "Did not return ESMF_SUCCESS"
  call ESMF_ArrayScatter(array, srcfarray_R4, rootPet=0, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
  
  !------------------------------------------------------------------------
  !NEX_UTest_Multi_Proc_Only
  ! Verify srcfarray_R4 data after scatter
  write(name, *) "Verifying srcfarray_R4 data after 2D ESMF_TYPEKIND_R4 ArrayScatter() Test"
  write(failMsg, *) "Source data was modified."
  rc = ESMF_SUCCESS
  do j=1, 23
    do i=1, 15
      value_R4 = srcfarray_R4(i,j) - srcfarray_R4_save(i,j)
      if (abs(value_R4) > min_R4) then
        print *, "Found mismatch value", i, j, value_R4
        rc = ESMF_FAILURE
      endif
   enddo
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX_UTest_Multi_Proc_Only
  ! Verify Array data after scatter
  write(name, *) "Verifying destination Array data after 2D ESMF_TYPEKIND_R4 ArrayScatter() Test"
  write(failMsg, *) "Array data wrong."
  rc = ESMF_SUCCESS
  do j=lbound(farrayPtr_R4,2), ubound(farrayPtr_R4,2)
    do i=lbound(farrayPtr_R4,1), ubound(farrayPtr_R4,1)
      if (abs(farrayPtr_R4(i,j) - srcfarray_R4(i,j)) > min_R4) then
        print *, "Found mismatch value", i, j, &
          abs(farrayPtr_R4(i,j) - srcfarray_R4(i,j))
        rc = ESMF_FAILURE
      endif
    enddo
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
  
  !------------------------------------------------------------------------
  ! cleanup  
  call ESMF_ArrayDestroy(array, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  call ESMF_DistGridDestroy(distgrid, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  deallocate(srcfarray_R4)
  deallocate(srcfarray_R4_save)
  
  !------------------------------------------------------------------------
  !------------------------------------------------------------------------

  !------------------------------------------------------------------------
  ! preparations for same test as above but with a DistGrid that has less
  ! elements in the first dimension than DEs requested in the regDecomp argument.
  ! -> there will be DEs not associated with DistGrid elements, namely DE 1 and
  ! DE 3.
  call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R8, rank=2, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/1,23/), &
    regDecomp=(/2,2/), rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, &
    indexflag=ESMF_INDEX_GLOBAL, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!call ESMF_ArrayPrint(array)
  call ESMF_ArrayGet(array, farrayPtr=farrayPtr, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  farrayPtr = real(localPet,ESMF_KIND_R8)  ! initialize each DE-local data chunk of Array
!print *, "farrayPtr:", farrayPtr
  ! prepare srcfarray on all PETs -> serves as ref. in comparison after scatter
  allocate(srcfarray(1:1, 1:23))
  allocate(srcfarray_save(1:1, 1:23))
  do j=1, 23
    do i=1, 1
      srcfarray(i,j) = 123._ESMF_KIND_R8*sin(real(i,ESMF_KIND_R8)) +  &
                       321._ESMF_KIND_R8*cos(real(j,ESMF_KIND_R8))
      srcfarray_save(i,j) = srcfarray(i,j)
    enddo
  enddo
!print *, "srcfarray:", srcfarray
  !------------------------------------------------------------------------
  !NEX_UTest_Multi_Proc_Only
  write(name, *) "2D ESMF_TYPEKIND_R8 ArrayScatter() with unassociated DEs Test"
  write(failMsg, *) "Did not return ESMF_SUCCESS"
  call ESMF_ArrayScatter(array, srcfarray, rootPet=0, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
  
  !------------------------------------------------------------------------
  !NEX_UTest_Multi_Proc_Only
  ! Verify srcfarray data after scatter
  write(failMsg, *) "Source data was modified."
  write(name, *) "Verifying srcfarray data after 2D ArrayScatter() Test"
  rc = ESMF_SUCCESS
  do j=1, 23
    do i=1, 1
      value = 123._ESMF_KIND_R8*sin(real(i,ESMF_KIND_R8)) +  &
              321._ESMF_KIND_R8*cos(real(j,ESMF_KIND_R8))
      value = srcfarray(i,j) - srcfarray_save(i,j)
      if (abs(value) > min_R8) then
        print *, "Found mismatch value", i, j, value
        rc = ESMF_FAILURE
      endif
   enddo
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX_UTest_Multi_Proc_Only
  ! Verify Array data after scatter
  write(failMsg, *) "Array data wrong."
  write(name, *) "Verifying destination Array data after 2D ArrayScatter() with unassociated DEs Test"
  rc = ESMF_SUCCESS
  do j=lbound(farrayPtr,2), ubound(farrayPtr,2)
    do i=lbound(farrayPtr,1), ubound(farrayPtr,1)
      if (abs(farrayPtr(i,j) - srcfarray(i,j)) > min_R8) then
        print *, "Found mismatch value", i, j, &
          abs(farrayPtr(i,j) - srcfarray(i,j))
        rc = ESMF_FAILURE
      endif
    enddo
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
  
  !------------------------------------------------------------------------
  ! cleanup  
  call ESMF_ArrayDestroy(array, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  call ESMF_DistGridDestroy(distgrid, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  deallocate(srcfarray)
  deallocate(srcfarray_save)

#ifdef ESMF_TESTEXHAUSTIVE

  !------------------------------------------------------------------------
  ! preparations for testing ArrayScatter() for a 
  ! 2D+1 Array, i.e. an Array with 3D data rank but 2D decomposition
  call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R8, rank=3, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/15,23/), &
    regDecomp=(/2,2/), rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, &
    indexflag=ESMF_INDEX_GLOBAL, undistLBound=(/-5/), undistUBound=(/4/), &
    rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!call ESMF_ArrayPrint(array)
  call ESMF_ArrayGet(array, farrayPtr=farrayPtr3d, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  farrayPtr3d = real(localPet,ESMF_KIND_R8)  ! initialize each DE-local data chunk of Array
!print *, "farrayPtr3d:", farrayPtr3d
  ! prepare srcfarray on all PETs -> serves as ref. in comparison after scatter
  allocate(srcfarray3d(1:15, 1:23, 10))
  allocate(srcfarray3d_save(1:15, 1:23, 10))
  do k=lbound(srcfarray3d,3), ubound(srcfarray3d,3)
    do j=lbound(srcfarray3d,2), ubound(srcfarray3d,2)
      do i=lbound(srcfarray3d,1), ubound(srcfarray3d,1)
        srcfarray3d(i,j,k) = 123._ESMF_KIND_R8*sin(real(i,ESMF_KIND_R8)) +  &
                             321._ESMF_KIND_R8*cos(real(j,ESMF_KIND_R8)) +  &
                             20._ESMF_KIND_R8*real(k,ESMF_KIND_R8)
        srcfarray3d_save(i,j,k) = srcfarray3d(i,j,k)
      enddo
    enddo
  enddo
!print *, "srcfarray3d:", srcfarray3d

  !------------------------------------------------------------------------
  !EX_UTest_Multi_Proc_Only
  write(failMsg, *) "Did not return ESMF_SUCCESS"
  write(name, *) "2D+1 ArrayScatter() Test"
  call ESMF_ArrayScatter(array, srcfarray3d, rootPet=0, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
  
  !------------------------------------------------------------------------
  !EX_UTest_Multi_Proc_Only
  ! Verify srcfarray3d data after scatter
  write(failMsg, *) "Source data was modified."
  write(name, *) "Verifying srcfarray3d data after 2D+1 ArrayScatter() Test"
  rc = ESMF_SUCCESS
  do k=lbound(srcfarray3d,3), ubound(srcfarray3d,3)
    do j=lbound(srcfarray3d,2), ubound(srcfarray3d,2)
      do i=lbound(srcfarray3d,1), ubound(srcfarray3d,1)
        value = 123._ESMF_KIND_R8*sin(real(i,ESMF_KIND_R8)) +   &
                321._ESMF_KIND_R8*cos(real(j,ESMF_KIND_R8)) +   &
                20._ESMF_KIND_R8*real(k,ESMF_KIND_R8)
        value = srcfarray3d(i,j,k) - srcfarray3d_save(i,j,k)
        if (abs(value) > min_R8) then
          print *, "Found mismatch value", i, j, k, value
          rc = ESMF_FAILURE
        endif
      enddo
    enddo
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !EX_UTest_Multi_Proc_Only
  ! Verify Array data after scatter
  write(failMsg, *) "Array data wrong."
  write(name, *) "Verifying destination Array data after 2D+1 ArrayScatter() Test"
  rc = ESMF_SUCCESS
  do k=lbound(farrayPtr3d,3), ubound(farrayPtr3d,3)
    kk = k - lbound(farrayPtr3d,3) + lbound(srcfarray3d,3)
    do j=lbound(farrayPtr3d,2), ubound(farrayPtr3d,2)
      do i=lbound(farrayPtr3d,1), ubound(farrayPtr3d,1)
        if (abs(farrayPtr3d(i,j,k) - srcfarray3d(i,j,kk)) > min_R8) then
          print *, "Found mismatch value", i, j, k, &
            abs(farrayPtr3d(i,j,k) - srcfarray3d(i,j,kk))
          rc = ESMF_FAILURE
        endif
      enddo
    enddo
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  ! cleanup  
  call ESMF_ArrayDestroy(array, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  deallocate(srcfarray3d)
  deallocate(srcfarray3d_save)
  
  !------------------------------------------------------------------------
  !------------------------------------------------------------------------

  !------------------------------------------------------------------------
  ! preparations for testing ArrayScatter() for a 2D+1 Array with 
  ! non-contiguous exclusive region 
  call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R8, rank=3, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, &
    totalLWidth=(/2,3/), totalUWidth=(/3,4/), indexflag=ESMF_INDEX_GLOBAL, &
    undistLBound=(/-5/), undistUBound=(/4/), rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!call ESMF_ArrayPrint(array)
  call ESMF_ArrayGet(array, farrayPtr=farrayPtr3d, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  farrayPtr3d = real(localPet,ESMF_KIND_R8)  ! initialize each DE-local data chunk of Array
!print *, "farrayPtr3d:", farrayPtr3d
  ! prepare srcfarray on all PETs -> serves as ref. in comparison after scatter
  allocate(srcfarray3d(1:15, 1:23, 10))
  allocate(srcfarray3d_save(1:15, 1:23, 10))
  do k=lbound(srcfarray3d,3), ubound(srcfarray3d,3)
    do j=lbound(srcfarray3d,2), ubound(srcfarray3d,2)
      do i=lbound(srcfarray3d,1), ubound(srcfarray3d,1)
        srcfarray3d(i,j,k) = 123._ESMF_KIND_R8*sin(real(i,ESMF_KIND_R8)) + &
                             321._ESMF_KIND_R8*cos(real(j,ESMF_KIND_R8)) + &
                             20._ESMF_KIND_R8*real(k,ESMF_KIND_R8)
        srcfarray3d_save(i,j,k) = srcfarray3d(i,j,k)
      enddo
    enddo
  enddo
!print *, "srcfarray3d:", srcfarray3d

  !------------------------------------------------------------------------
  !EX_UTest_Multi_Proc_Only
  write(failMsg, *) "Did not return ESMF_SUCCESS"
  write(name, *) "2D+1 non-contiguous exclusive region ArrayScatter() Test"
  call ESMF_ArrayScatter(array, srcfarray3d, rootPet=0, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
  
!call ESMF_ArrayPrint(array)  
  
  !------------------------------------------------------------------------
  !EX_UTest_Multi_Proc_Only
  write(failMsg, *) "Did not return ESMF_SUCCESS"
  write(name, *) "ArrayGet() Test"
  call ESMF_ArrayGet(array, exclusiveLBound=exclusiveLBound, &
    exclusiveUBound=exclusiveUBound, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
  
  !------------------------------------------------------------------------
  !EX_UTest_Multi_Proc_Only
  ! Verify srcfarray3d data after scatter
  write(failMsg, *) "Source data was modified."
  write(name, *) "Verifying srcfarray3d data after 2D+1 non-contiguous exclusive ",&
    "region ArrayScatter() Test"
  rc = ESMF_SUCCESS
  do k=lbound(srcfarray3d,3), ubound(srcfarray3d,3)
    do j=lbound(srcfarray3d,2), ubound(srcfarray3d,2)
      do i=lbound(srcfarray3d,1), ubound(srcfarray3d,1)
        value = 123._ESMF_KIND_R8*sin(real(i,ESMF_KIND_R8)) +  &
                321._ESMF_KIND_R8*cos(real(j,ESMF_KIND_R8)) +  &
                 20._ESMF_KIND_R8*real(k,ESMF_KIND_R8)
        value = srcfarray3d(i,j,k) - srcfarray3d_save(i,j,k)
        if (abs(value) > min_R8) then
          print *, "Found mismatch value", i, j, k, value
          rc = ESMF_FAILURE
        endif
      enddo
    enddo
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !EX_UTest_Multi_Proc_Only
  ! Verify Array data after scatter
  write(name, *) "Verifying destination Array data after 2D+1 non-contiguous ",&
    "exclusive region ArrayScatter() Test"
  write(failMsg, *) "Array data wrong."
  rc = ESMF_SUCCESS
  do k=lbound(farrayPtr3d,3), ubound(farrayPtr3d,3)
    kk = k - lbound(farrayPtr3d,3) + lbound(srcfarray3d,3)
    do j=exclusiveLBound(2,1), exclusiveUBound(2,1)
      do i=exclusiveLBound(1,1), exclusiveUBound(1,1)
        if (abs(farrayPtr3d(i,j,k) - srcfarray3d(i,j,kk)) > min_R8) then
          print *, "Found mismatch value", i, j, k, &
            abs(farrayPtr3d(i,j,k) - srcfarray3d(i,j,kk))
          rc = ESMF_FAILURE
        endif
      enddo
    enddo
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  ! cleanup  
  call ESMF_ArrayDestroy(array, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  call ESMF_DistGridDestroy(distgrid, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  deallocate(srcfarray3d)
  deallocate(srcfarray3d_save)

  !------------------------------------------------------------------------
  !------------------------------------------------------------------------

  !------------------------------------------------------------------------
  ! preparations for testing ArrayScatter() for a 2D+1 Array with 
  ! non-contiguous exclusive region and cyclic decomposition
  call ESMF_ArraySpecSet(arrayspec, typekind=ESMF_TYPEKIND_R8, rank=3, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  distgrid = ESMF_DistGridCreate(minIndex=(/0,1/), maxIndex=(/14,23/), &
    regDecomp=(/2,2/), decompflag=(/ESMF_DECOMP_BALANCED,ESMF_DECOMP_CYCLIC/),&
    rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  array = ESMF_ArrayCreate(arrayspec=arrayspec, distgrid=distgrid, &
    totalLWidth=(/2,3/), totalUWidth=(/3,4/), &
    undistLBound=(/-5/), undistUBound=(/4/), rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!call ESMF_ArrayPrint(array)
  call ESMF_ArrayGet(array, farrayPtr=farrayPtr3d, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  farrayPtr3d = real(localPet,ESMF_KIND_R8)  ! initialize each DE-local data chunk of Array
!print *, "farrayPtr3d:", farrayPtr3d
  ! prepare srcfarray on all PETs -> serves as ref. in comparison after scatter
  allocate(srcfarray3d(15, 23, 10))
  allocate(srcfarray3d_save(15, 23, 10))
  do k=lbound(srcfarray3d,3), ubound(srcfarray3d,3)
    do j=lbound(srcfarray3d,2), ubound(srcfarray3d,2)
      do i=lbound(srcfarray3d,1), ubound(srcfarray3d,1)
        srcfarray3d(i,j,k) = 123._ESMF_KIND_R8*sin(real(i,ESMF_KIND_R8)) + &
                             321._ESMF_KIND_R8*cos(real(j,ESMF_KIND_R8)) + &
                             20._ESMF_KIND_R8*real(k,ESMF_KIND_R8)
        srcfarray3d_save(i,j,k) = srcfarray3d(i,j,k)
      enddo
    enddo
  enddo
!print *, "srcfarray3d:", srcfarray3d

  !------------------------------------------------------------------------
  !EX_UTest_Multi_Proc_Only
  write(name, *) "2D+1 non-contiguous exclusive region and cyclic decomposition ",&
    "ArrayScatter() Test"
  write(failMsg, *) "Did not return ESMF_SUCCESS"
  call ESMF_ArrayScatter(array, srcfarray3d, rootPet=0, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
  
!call ESMF_ArrayPrint(array)  
  
  !------------------------------------------------------------------------
  !EX_UTest_Multi_Proc_Only
  write(failMsg, *) "Did not return ESMF_SUCCESS"
  write(name, *) "ArrayGet() Test"
  call ESMF_ArrayGet(array, localDe=0, dim=1, indexCount=dimExtent1, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
  
  allocate(indexList1(dimExtent1))
  
  !------------------------------------------------------------------------
  !EX_UTest_Multi_Proc_Only
  write(failMsg, *) "Did not return ESMF_SUCCESS"
  write(name, *) "ArrayGet() Test"
  call ESMF_ArrayGet(array, localDe=0, dim=1, indexList=indexList1, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
  
  !------------------------------------------------------------------------
  !EX_UTest_Multi_Proc_Only
  write(failMsg, *) "Did not return ESMF_SUCCESS"
  write(name, *) "ArrayGet() Test"
  call ESMF_ArrayGet(array, localDe=0, dim=2, indexCount=dimExtent2, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
  
  allocate(indexList2(dimExtent2))
  
  !------------------------------------------------------------------------
  !EX_UTest_Multi_Proc_Only
  write(failMsg, *) "Did not return ESMF_SUCCESS"
  write(name, *) "ArrayGet() Test"
  call ESMF_ArrayGet(array, localDe=0, dim=2, indexList=indexList2, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
  
  !------------------------------------------------------------------------
  !EX_UTest_Multi_Proc_Only
  ! Verify srcfarray3d data after scatter
  write(name, *) "Verifying srcfarray3d data after 2D+1 non-contiguous ",&
    "exclusive region and cyclic decomposition ArrayScatter() Test"
  write(failMsg, *) "Source data was modified."
  rc = ESMF_SUCCESS
  do k=lbound(srcfarray3d,3), ubound(srcfarray3d,3)
    do j=lbound(srcfarray3d,2), ubound(srcfarray3d,2)
      do i=lbound(srcfarray3d,1), ubound(srcfarray3d,1)
        value = 123._ESMF_KIND_R8*sin(real(i,ESMF_KIND_R8)) +  &
                321._ESMF_KIND_R8*cos(real(j,ESMF_KIND_R8)) +  &
                 20._ESMF_KIND_R8*real(k,ESMF_KIND_R8)
        value = srcfarray3d(i,j,k) - srcfarray3d_save(i,j,k)
        if (abs(value) > min_R8) then
          print *, "Found mismatch value", i, j, k, value
          rc = ESMF_FAILURE
        endif
      enddo
    enddo
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !EX_UTest_Multi_Proc_Only
  ! Verify Array data after scatter
  write(name, *) "Verifying destination Array data after 2D+1 non-contiguous ",&
    "exclusive region and cyclic decomposition ArrayScatter() Test"
  write(failMsg, *) "Array data wrong."
  rc = ESMF_SUCCESS
  do k=lbound(farrayPtr3d,3), ubound(farrayPtr3d,3)
    ! correct wrt lbound
    kk = k - lbound(farrayPtr3d,3) + lbound(srcfarray3d,3)
    do j=1, dimExtent2
      ! dereference via indexList and correct wrt lbound 
      jj = indexList2(j) - 1 + lbound(srcfarray3d,2)
      do i=1, dimExtent1
        ! dereference via indexList and correct wrt lbound 
        ii = indexList1(i) - 0 + lbound(srcfarray3d,1)
        if (abs(farrayPtr3d(i,j,k) - srcfarray3d(ii,jj,kk)) > min_R8) then
          print *, "Found mismatch value", i, j, k, &
            abs(farrayPtr3d(i,j,k) - srcfarray3d(ii,jj,kk))
          rc = ESMF_FAILURE
        endif
      enddo
    enddo
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  ! cleanup  
  call ESMF_ArrayDestroy(array, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  call ESMF_DistGridDestroy(distgrid, rc=rc)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
  deallocate(srcfarray3d)
  deallocate(srcfarray3d_save)
  deallocate(indexList1)
  deallocate(indexList2)
  
#endif
  

10 continue
  !------------------------------------------------------------------------
  call ESMF_TestEnd(ESMF_SRCLINE) ! calls ESMF_Finalize() internally
  !------------------------------------------------------------------------


end program ESMF_ArrayScatterUTest
