! $Id$
!
! Earth System Modeling Framework
! Copyright (c) 2002-2025, 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_VMAllToAllVUTest

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

!==============================================================================
!BOP
! !PROGRAM: ESMF_VMAllToAllVUTest - Unit test for VMAllToAllV Functions
!
! !DESCRIPTION:
!
! The code in this file drives the F90 VMAllToAllV tests.
!   It runs on multiple processors.
!
!-----------------------------------------------------------------------------
! !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 failure message
  character(ESMF_MAXSTR) :: failMsg
  character(ESMF_MAXSTR) :: name

  ! local variables
  integer::  localrc, rc
  type(ESMF_VM):: vm
  integer:: localPet, petCount
  integer:: nlen1, nlen2, nsize, i, j, k
  integer, allocatable:: sendCounts(:), sendOffsets(:)
  integer, allocatable:: recvCounts(:), recvOffsets(:)
  integer, allocatable:: iarray1(:), iarray2(:), iarray3(:)
  real(ESMF_KIND_R4), allocatable:: f4array1(:), f4array2(:), f4array3(:)
  real(ESMF_KIND_R8), allocatable:: f8array1(:), f8array2(:), f8array3(:)
  logical, allocatable:: larray1(:), larray2(:), larray3(:)
     
  type(ESMF_VMId), allocatable :: vmids_array1(:)
  type(ESMF_VMId), allocatable :: vmids_array2(:)
  type(ESMF_VMId), allocatable :: vmids_array3(:)
  integer   :: idData
  character :: keyData
  logical   :: all_verify


!------------------------------------------------------------------------------
!   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
!   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)
  if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)

  ! get global vm information
  call ESMF_VMGetGlobal(vm, rc=rc)
  call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=rc)

  ! allocate arrays
  allocate(sendCounts(petCount))
  allocate(sendOffsets(petCount))
  allocate(recvCounts(petCount))
  allocate(recvOffsets(petCount))
  nsize = 33
  nlen1 = 0
  do i=1, petCount
    sendOffsets(i) = nlen1 * nsize
    sendCounts(i) = i * nsize
    recvOffsets(i) = (i-1) * (localPet + 1) * nsize
    recvCounts(i) = (localPet + 1) * nsize
    nlen1 = nlen1 + i
  enddo
  nlen1 = nlen1 * nsize
  nlen2 = (localPet + 1) * nsize * petCount
  allocate(iarray1(nlen1))
  allocate(iarray2(nlen2))
  allocate(iarray3(nlen1))
  allocate(f4array1(nlen1))
  allocate(f4array2(nlen2))
  allocate(f4array3(nlen1))
  allocate(f8array1(nlen1))
  allocate(f8array2(nlen2))
  allocate(f8array3(nlen1))
  
  allocate(larray1(nlen1))
  allocate(larray2(nlen2))
  allocate(larray3(nlen1))

  ! prepare data array1
  k=1
  do i=1, petCount
    do j=1, nsize * i
      iarray1(k) = i + 100 * k + 10000 * j
      f4array1(k) = real(iarray1(k), ESMF_KIND_R4)
      f8array1(k) = real(iarray1(k), ESMF_KIND_R8)
      larray1(k) = mod (i, 3) == 0
      k = k+1
    enddo
  enddo

  !Testing with Integer arguments
  !==============================
  !------------------------------------------------------------------------
  !NEX_UTest
  write(name, *) "AllToAllV Test iarray1 -> iarray2"
  write(failMsg, *) "Did not return ESMF_SUCCESS."
  call ESMF_VMAllToAllV(vm, sendData=iarray1, sendCounts=sendCounts, &
    sendOffsets=sendOffsets, recvData=iarray2, recvCounts=recvCounts, &
    recvOffsets=recvOffsets, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX_UTest
  write(name, *) "AllToAllV Test iarray2 -> iarray3"
  write(failMsg, *) "Did not return ESMF_SUCCESS."
  call ESMF_VMAllToAllV(vm, sendData=iarray2, sendCounts=recvCounts, &
    sendOffsets=recvOffsets, recvData=iarray3, recvCounts=sendCounts, &
    recvOffsets=sendOffsets, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX_UTest
  ! Verify iarray3 data against iarray1 after alltoallv
  write(failMsg, *) "Wrong data."
  write(name, *) "Verify iarray3 data against iarray1 after alltoallv"
  rc = ESMF_SUCCESS
  do i=1, nlen1
    if (iarray3(i)/=iarray1(i)) then
      rc = ESMF_FAILURE
      print *, i, iarray1(i), iarray3(i)
    endif
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)


  !Testing with Real*4 arguments
  !==============================
  !------------------------------------------------------------------------
  !NEX_UTest
  write(name, *) "AllToAllV Test f4array1 -> f4array2"
  write(failMsg, *) "Did not return ESMF_SUCCESS."
  call ESMF_VMAllToAllV(vm, sendData=f4array1, sendCounts=sendCounts, &
    sendOffsets=sendOffsets, recvData=f4array2, recvCounts=recvCounts, &
    recvOffsets=recvOffsets, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX_UTest
  write(name, *) "AllToAllV Test f4array2 -> f4array3"
  write(failMsg, *) "Did not return ESMF_SUCCESS."
  call ESMF_VMAllToAllV(vm, sendData=f4array2, sendCounts=recvCounts, &
    sendOffsets=recvOffsets, recvData=f4array3, recvCounts=sendCounts, &
    recvOffsets=sendOffsets, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX_UTest
  ! Verify f4array3 data against f4array1 after alltoallv
  write(failMsg, *) "Wrong data."
  write(name, *) "Verify f4array3 data against f4array1 after alltoallv"
  rc = ESMF_SUCCESS
  do i=1, nlen1
    if (f4array3(i)/=f4array1(i)) then
      rc = ESMF_FAILURE
      print *, i, f4array1(i), f4array3(i)
    endif
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)


  !Testing with Real*8 arguments
  !==============================
  !------------------------------------------------------------------------
  !NEX_UTest
  write(name, *) "AllToAllV Test f8array1 -> f8array2"
  write(failMsg, *) "Did not return ESMF_SUCCESS."
  call ESMF_VMAllToAllV(vm, sendData=f8array1, sendCounts=sendCounts, &
    sendOffsets=sendOffsets, recvData=f8array2, recvCounts=recvCounts, &
    recvOffsets=recvOffsets, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX_UTest
  write(name, *) "AllToAllV Test f8array2 -> f8array3"
  write(failMsg, *) "Did not return ESMF_SUCCESS."
  call ESMF_VMAllToAllV(vm, sendData=f8array2, sendCounts=recvCounts, &
    sendOffsets=recvOffsets, recvData=f8array3, recvCounts=sendCounts, &
    recvOffsets=sendOffsets, rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX_UTest
  ! Verify f8array3 data against f8array1 after alltoallv
  write(failMsg, *) "Wrong data."
  write(name, *) "Verify f8array3 data against f8array1 after alltoallv"
  rc = ESMF_SUCCESS
  do i=1, nlen1
    if (f8array3(i)/=f8array1(i)) then
      rc = ESMF_FAILURE
      print *, i, f8array1(i), f8array3(i)
    endif
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)


  !Testing with logical arguments
  !==============================
  !------------------------------------------------------------------------
  !NEX_UTest
  write(name, *) "AllToAllV Test larray1 -> larray2"
  write(failMsg, *) "Did not return ESMF_SUCCESS."
  larray2 = .false.
  call ESMF_VMAllToAllV(vm,  &
      sendData=larray1, sendCounts=sendCounts, sendOffsets=sendOffsets,  &
      recvData=larray2, recvCounts=recvCounts, recvOffsets=recvOffsets,  &
      rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX_UTest
  write(name, *) "AllToAllV Test larray2 -> larray3"
  write(failMsg, *) "Did not return ESMF_SUCCESS."
  larray3 = .false.
  call ESMF_VMAllToAllV(vm,  &
      sendData=larray2, sendCounts=recvCounts, sendOffsets=recvOffsets,  &
      recvData=larray3, recvCounts=sendCounts, recvOffsets=sendOffsets,  &
      rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX_UTest
  ! Verify larray3 data against larray1 after alltoallv
  write(failMsg, *) "Wrong data."
  write(name, *) "Verify larray3 data against larray1 after alltoallv"
  rc = ESMF_SUCCESS
  do i=1, nlen1
    if (larray3(i) .neqv. larray1(i)) then
      rc = ESMF_FAILURE
      print *, i, larray1(i), larray3(i)
    endif
  enddo
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)


  !Test with VMId arguments
  !===========================
#if 0
  !------------------------------------------------------------------------
  !NEX____noUTest
  ! Create VMid arrays on both root and destinations
  write(failMsg, *) "Did not RETURN ESMF_SUCCESS"
  write(name, *) "Creating VMId array1 Test"
  allocate (vmids_array1(nlen1))
  call ESMF_VMIdCreate (vmids_array1, rc=rc)
  call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX____noUTest
  ! Create VMid arrays on both root and destinations
  write(failMsg, *) "Did not RETURN ESMF_SUCCESS"
  write(name, *) "Creating VMId array2 Test"
  allocate (vmids_array2(nlen2))
  call ESMF_VMIdCreate (vmids_array2, rc=rc)
  call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX____noUTest
  ! Create VMid arrays on both root and destinations
  write(failMsg, *) "Did not RETURN ESMF_SUCCESS"
  write(name, *) "Creating VMId array3 Test"
  allocate (vmids_array3(nlen1))
  call ESMF_VMIdCreate (vmids_array3, rc=rc)
  call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX____noUTest
  ! Create VMid arrays on both root and destinations
  write(failMsg, *) "Did not RETURN ESMF_SUCCESS"
  write(name, *) "Creating VMId array3 Test"
  ! Insert dummy data for the purposes of the test.  Only
  ! the first character of the key is set.
  rc = ESMF_SUCCESS
  do, i=1, nlen1
    call c_ESMCI_VMIdSet (vmids_array1(i),  i, achar (iand (i, z"7f")), localrc)
    if (localrc /= ESMF_SUCCESS) rc = localrc
  end do
  do, i=1, nlen2
    call c_ESMCI_VMIdSet (vmids_array2(i), -1, achar (iand (i, z"7f")), localrc)
    if (localrc /= ESMF_SUCCESS) rc = localrc
  end do
  do, i=1, nlen1
    call c_ESMCI_VMIdSet (vmids_array3(i), -1, achar (iand (i, z"ff")), localrc)
    if (localrc /= ESMF_SUCCESS) rc = localrc
  end do
  call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX____noUTest
  write(name, *) "AllToAllVMId Test vmids_array1 -> vmids_array2"
  write(failMsg, *) "Did not return ESMF_SUCCESS."
! print *, 'sendCounts: ', sendCounts
! print *, 'sendOffsets: ', sendOffsets
! print *, 'recvCounts: ', recvCounts
! print *, 'recvOffsets: ', recvOffsets
  call ESMF_VMAllToAllVVMId(vm,  &
      sendData=vmids_array1, sendCounts=sendCounts, sendOffsets=sendOffsets, &
      recvData=vmids_array2, recvCounts=recvCounts, recvOffsets=recvOffsets, &
      rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX____noUTest
  write(name, *) "AllToAllVMId Test vmids_array2 -> vmids_array3"
  write(failMsg, *) "Did not return ESMF_SUCCESS."
  call ESMF_VMAllToAllVVMId(vm,  &
      sendData=vmids_array2, sendCounts=recvCounts, sendOffsets=recvOffsets,  &
      recvData=vmids_array3, recvCounts=sendCounts, recvOffsets=sendOffsets,  &
      rc=rc)
  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX____noUTest
  ! Verify iarray3 data against iarray1 after alltoallvmid
  write(failMsg, *) "Wrong data."
  write(name, *) "Verify iarray3 data against iarray1 after alltoallv"
  rc = ESMF_SUCCESS
  do i=1, nlen1
    if (iarray3(i)/=iarray1(i)) then
      rc = ESMF_FAILURE
      print *, i, iarray1(i), iarray3(i)
    endif
  enddo

  call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX____noUTest
  ! Release VMId resources
  write(failMsg, *) "Did not RETURN ESMF_SUCCESS"
  write(name, *) "Releasing VMId array1 Test"
  call ESMF_VMIdDestroy (vmids_array1, rc=rc)
  deallocate (vmids_array1)
  call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX____noUTest
  ! Release VMId resources
  write(failMsg, *) "Did not RETURN ESMF_SUCCESS"
  write(name, *) "Releasing VMId array2 Test"
  call ESMF_VMIdDestroy (vmids_array2, rc=rc)
  deallocate (vmids_array2)
  call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

  !------------------------------------------------------------------------
  !NEX____noUTest
  ! Release VMId resources
  write(failMsg, *) "Did not RETURN ESMF_SUCCESS"
  write(name, *) "Releasing VMId array3 Test"
  call ESMF_VMIdDestroy (vmids_array3, rc=rc)
  deallocate (vmids_array3)
  call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#endif

  call ESMF_TestEnd(ESMF_SRCLINE)

  ! garbage collection
  deallocate(sendCounts)
  deallocate(sendOffsets)
  deallocate(recvCounts)
  deallocate(recvOffsets)
  deallocate(iarray1)
  deallocate(iarray2)
  deallocate(iarray3)
  deallocate(f4array1)
  deallocate(f4array2)
  deallocate(f4array3)
  deallocate(f8array1)
  deallocate(f8array2)
  deallocate(f8array3)
  
  deallocate(larray1)
  deallocate(larray2)
  deallocate(larray3)

end program ESMF_VMAllToAllVUTest
