! $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_FieldCommEx

!------------------------------------------------------------------------------
!ESMF_MULTI_PROC_EXAMPLE        String used by test script to count examples.
!==============================================================================
! !PROGRAM: ESMF_FieldCommEx - Field level communication routines
!
! !DESCRIPTION:
!
! Example/test code which does communication operations on Fields,
! including examples of using Redist, Halo, and Regrid on a Field.
! Also see the Programming Model section of this document.
!-----------------------------------------------------------------------------

#include "ESMF.h"
#include "ESMF_Macros.inc"
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_FieldCommEx"

    ! ESMF Framework module
    use ESMF
    use ESMF_TestMod

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

    ! Local variables
    integer :: rc, finalrc

    ! local arguments used to create field etc
    type(ESMF_Field)                            :: field
    type(ESMF_Grid)                             :: grid
    type(ESMF_VM)                               :: vm
    integer                                     :: localrc, lpe, i, j

    integer, allocatable                        :: farrayDst(:,:)
    integer, allocatable                        :: farraySrc(:,:)
    integer                                     :: result
    integer, pointer                            :: fptr(:,:)
    character(ESMF_MAXSTR) :: testname
    character(ESMF_MAXSTR) :: failMsg

    rc = ESMF_SUCCESS
    finalrc = ESMF_SUCCESS
    localrc = ESMF_SUCCESS

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

    write(failMsg, *) "Example failure"
    write(testname, *) "Example ESMF_FieldCommEx"

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


!------------------------------------------------------------------------------
    call ESMF_Initialize(defaultlogfilename="FieldCommEx.Log", &
                    logkindflag=ESMF_LOGKIND_MULTI, rc=rc)
    if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)

    if (.not. ESMF_TestMinPETs(4, ESMF_SRCLINE)) &
        call ESMF_Finalize(endflag=ESMF_END_ABORT)
!------------------------------------------------------------------------------
!BOE
! \subsubsection{Gather Field data onto root PET}
! \label{sec:field:usage:gather_2dptr}
!
! User can use {\tt ESMF\_FieldGather} interface to gather Field data from multiple
! PETs onto a single root PET. This interface is overloaded by type, kind, and rank.
!
! Note that the implementation of Scatter and Gather is not sequence index based.
! If the Field is built on arbitrarily distributed Grid, Mesh, LocStream or XGrid, 
! Gather will not gather data to rootPet 
! from source data points corresponding to the sequence index on the rootPet. 
! Instead Gather will gather a contiguous memory range from source PET to
! rootPet. The size of the memory range is equal to the number of 
! data elements on the source PET. Vice versa for the Scatter operation. 
! In this case, the user should use {\tt ESMF\_FieldRedist} to achieve
! the same data operation result. For examples how to use {\tt ESMF\_FieldRedist}
! to perform Gather and Scatter, please refer to
! \ref{sec:field:usage:redist_gathering} and
! \ref{sec:field:usage:redist_scattering}.
! 
! In this example, we first create a 2D Field, then use {\tt ESMF\_FieldGather} to
! collect all the data in this Field into a data pointer on PET 0.
!EOE
!BOC 
    ! Get current VM and pet number
    call ESMF_VMGetCurrent(vm, rc=rc)
    if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)

    call ESMF_VMGet(vm, localPet=lpe, rc=rc)
    if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)

    ! Create a 2D Grid and use this grid to create a Field
    ! farray is the Fortran data array that contains data on each PET.
    grid = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=(/10,20/), &
        regDecomp=(/2,2/), &
        name="grid", rc=rc)
    if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)

    field = ESMF_FieldCreate(grid, typekind=ESMF_TYPEKIND_I4, rc=localrc)
    if (localrc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)


    call ESMF_FieldGet(field, farrayPtr=fptr, rc=localrc)
    if (localrc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
    !---------Initialize pet specific field data----------------
    !    1        5         10
    ! 1  +--------+---------+
    !    |        |         |
    !    |   0    |    1    |
    !    |        |         |
    ! 10 +--------+---------+
    !    |        |         |
    !    |   2    |    3    |
    !    |        |         |
    ! 20 +--------+---------+
    fptr = lpe

    ! allocate the Fortran data array on PET 0 to store gathered data
    if(lpe .eq. 0) then
      allocate (farrayDst(10,20))
    else
      allocate (farrayDst(0,0))
    end if
    call ESMF_FieldGather(field, farrayDst, rootPet=0, rc=rc)
    if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)

    ! check that the values gathered on rootPet are correct
    if(lpe .eq. 0) then
       do i = 1, 5
          do j = 1, 10
             if(farrayDst(i, j) .ne. 0) localrc=ESMF_FAILURE
          enddo
       enddo
      if (localrc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
       do i = 6, 10
          do j = 1, 10
             if(farrayDst(i, j) .ne. 1) localrc=ESMF_FAILURE
          enddo
       enddo
      if (localrc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
       do i = 1, 5
          do j = 11, 20
             if(farrayDst(i, j) .ne. 2) localrc=ESMF_FAILURE
          enddo
       enddo
      if (localrc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
       do i = 6, 10
          do j = 11, 20
             if(farrayDst(i, j) .ne. 3) localrc=ESMF_FAILURE
          enddo
       enddo
      if (localrc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
    endif

    ! destroy all objects created in this example to prevent memory leak
    call ESMF_FieldDestroy(field, rc=rc)
    if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
    call ESMF_GridDestroy(grid, rc=rc)
    if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
    if(lpe .eq. 0) deallocate(farrayDst)
!EOC

!------------------------------------------------------------------------------
!BOE
! \subsubsection{Scatter Field data from root PET onto its set of joint PETs}
! \label{sec:field:usage:scatter_2dptr}
!
! User can use {\tt ESMF\_FieldScatter} interface to scatter Field data from root
! PET onto its set of joint PETs. This interface is overloaded by type, kind, and rank.
! 
! In this example, we first create a 2D Field, then use {\tt ESMF\_FieldScatter} to
! scatter the data from a data array located on PET 0 onto this Field.
!EOE
!BOC 
    ! Create a 2D Grid and use this grid to create a Field
    ! farray is the Fortran data array that contains data on each PET.
    grid = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=(/10,20/), &
        regDecomp=(/2,2/), &
        name="grid", rc=rc)
    if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)

    field = ESMF_FieldCreate(grid, typekind=ESMF_TYPEKIND_I4, rc=localrc)
    if (localrc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)

    ! initialize values to be scattered
    !    1        5         10
    ! 1  +--------+---------+
    !    |        |         |
    !    |   0    |    1    |
    !    |        |         |
    ! 10 +--------+---------+
    !    |        |         |
    !    |   2    |    3    |
    !    |        |         |
    ! 20 +--------+---------+
    if(lpe .eq. 0) then
        allocate(farraySrc(10,20))
        farraySrc(1:5,1:10) = 0
        farraySrc(6:10,1:10) = 1
        farraySrc(1:5,11:20) = 2
        farraySrc(6:10,11:20) = 3
    else
      allocate (farraySrc(0,0))
    endif

    ! scatter the data onto individual PETs of the Field
    call ESMF_FieldScatter(field, farraySrc, rootPet=0, rc=rc)
    if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)

    call ESMF_FieldGet(field, localDe=0, farrayPtr=fptr, rc=rc)
    if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)

    ! verify that the scattered data is properly distributed
    do i = lbound(fptr, 1), ubound(fptr, 1)
        do j = lbound(fptr, 2), ubound(fptr, 2)
            if(fptr(i, j) .ne. lpe) localrc = ESMF_FAILURE
        enddo
        if (localrc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
    enddo

    ! destroy all objects created in this example to prevent memory leak
    call ESMF_FieldDestroy(field, rc=rc)
    if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
    call ESMF_GridDestroy(grid, rc=rc)
    if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
    if(lpe .eq. 0) deallocate(farraySrc)
!EOC
!------------------------------------------------------------------------------
    if (finalrc.EQ.ESMF_SUCCESS) then
       print *, "PASS: ESMF_FieldCommEx.F90"
    else
       print *, "FAIL: ESMF_FieldCommEx.F90"
    end if

    ! IMPORTANT: ESMF_STest() prints the PASS string and the # of processors in the log
    ! file that the scripts grep for.
    call ESMF_STest((finalrc.eq.ESMF_SUCCESS), testname, failMsg, result, ESMF_SRCLINE)


    call ESMF_Finalize(rc=rc)

    end program ESMF_FieldCommEx
    
!\end{verbatim}
