! $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.
!
!===============================================================================
#define ESMF_FILENAME "ESMF_TestHarnessMod"
!
!  ESMF Test Harness Module
   module ESMF_TestHarnessMod
!
!===============================================================================
!
! This file contains parameters, global data types, and parser
! functions/subroutines for the Testing Harness.
! These methods are used by the test harness driver ESMF_TestHarnessUTest.F90.
!
!-------------------------------------------------------------------------------
! INCLUDES
#include "ESMF.h"
!===============================================================================
!BOPI
! !MODULE: ESMF_TestHarnessMod
!
! !DESCRIPTION:
!
! The code in this file contains data types and basic functions for the
! {\tt ESMF\_TestHarness}.
!  Expand on the type of routines included here
!
!-------------------------------------------------------------------------------
!
! !USES:

  use ESMF_TestHarnessReportMod

  use ESMF
  use ESMF_RegridMod
  use ESMF_FieldMod
  use ESMF_GridUtilMod

  use ESMF_FieldGetMod

  implicit none
  private

!-------------------------------------------------------------------------------
! PUBLIC METHODS:
!-------------------------------------------------------------------------------
  public array_redist_test, field_regrid_test, field_redist_test

!===============================================================================
! debug trace switch
logical                       :: checkpoint = .FALSE.

  contains

!===============================================================================


!-------------------------------------------------------------------------------
!===============================================================================
! Public Methods
!===============================================================================
  !-----------------------------------------------------------------------------
  subroutine array_redist_test(PDS, test_failure, reportType, VM, rc)
  !-----------------------------------------------------------------------------
  !
  !-----------------------------------------------------------------------------
  ! arguments
  type(problem_descriptor_strings), intent(inout) :: PDS
  character(THARN_MAXSTR), intent(in   ) :: reportType
  type(ESMF_VM), intent(in   ) :: VM
  integer, intent(inout) :: test_failure
  integer, intent(  out) :: rc

  ! local parameters
  real(ESMF_KIND_R8), parameter :: initvalue = 0.0

  ! local ESMF Types
  type(ESMF_Array) :: src_array, return_array, dst_array
  type(ESMF_DistGrid) :: src_distgrid, dst_distgrid
  type(ESMF_RouteHandle) :: redistHandle_forward, redistHandle_reverse

  ! local integers
  integer :: localrc ! local error status
  integer :: iDfile, iGfile, iD, iG
  integer :: test_status

  integer :: localPET

  ! local characters
  character(THARN_MAXSTR) :: liG, liD

  ! debug
  ! real(ESMF_KIND_R8), pointer :: farrayPtr2(:,:)
  ! integer ::de, localDeCount, dimCount
  ! integer :: i1, i2
  ! integer, allocatable ::  localDeToDeMap(:)
  ! type(ESMF_LocalArray), allocatable :: larrayList(:)
  ! integer, allocatable :: LBnd(:,:), UBnd(:,:)
  ! type(ESMF_Index_Flag) :: indexflag

  ! initialize return flag
  localrc = ESMF_RC_NOT_IMPL
  rc = ESMF_RC_NOT_IMPL

  ! initialize test counter
  test_failure = 0

  call ESMF_VMGet(VM, localPet=localPET, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"can not get local pet ",          &
                  rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! for a single problem descriptor string, loop through each specifier file
  ! combination
  !-----------------------------------------------------------------------------
  if (localPet == 0) then
    print*,'-----------------======array redist test==========-----------------------'
  end if

  do iDfile=1,PDS%nDfiles         ! distribution specifier files
    do iGfile=1,PDS%nGfiles       ! grid specifier files
      do iD=1, PDS%Dfiles(iDfile)%nDspecs   ! entries in distribution specifier
        do iG=1, PDS%Gfiles(iGfile)%nGspecs ! entries in grid specifier file
          write(liG,"(i5)") iG
          write(liD,"(i5)") iD

          if (localPet == 0) then
            print '(A)',"array redist test - "  &
               // " with string "  // trim(adjustL(PDS%pds)) //                  &
               " with entry "  // trim(adjustL(liD)) // " of file " //           &
               trim(adjustL(PDS%Dfiles(iDfile)%filename))                        &
               // " and entry " // trim(adjustL(liG)) // " of file " //          &
               trim(adjustL(PDS%Gfiles(iGfile)%filename))
          end if

          !---------------------------------------------------------------------
          ! create source and destination distributions
          !---------------------------------------------------------------------
          call create_distribution(PDS%SrcMem, PDS%Dfiles(iDfile)%src_dist(iD),&
                    PDS%Gfiles(iGfile)%src_grid(iG), src_distgrid, VM, localrc)

          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating source distgrid "  &
             // " with string "  // trim(adjustL(PDS%pds)) //                  &
             " with entry "  // trim(adjustL(liD)) // " of file " //           &
             trim(adjustL(PDS%Dfiles(iDfile)%filename))                        &
             // " and entry " // trim(adjustL(liG)) // " of file " //          &
             trim(adjustL(PDS%Gfiles(iGfile)%filename)),                       &
             rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! create source array
          !---------------------------------------------------------------------
          call create_array(src_array, src_distgrid, PDS%SrcMem,               &
                      PDS%Gfiles(iGfile)%src_grid(iG), localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating source array "     &
             // " with string "  // trim(adjustL(PDS%pds)) //                  &
             " with entry "  // trim(adjustL(liD)) // " of file " //           &
             trim(adjustL(PDS%Dfiles(iDfile)%filename))                        &
             // " and entry " // trim(adjustL(liG)) // " of file " //          &
             trim(adjustL(PDS%Gfiles(iGfile)%filename)),                       &
             rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! populate source array for redistribution test
          !---------------------------------------------------------------------
          call populate_redist_array(src_array, src_distgrid, PDS%SrcMem,      &
                       PDS%Gfiles(iGfile)%src_grid(iG), localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error populating source array ",  &
                  rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! create return array
          !---------------------------------------------------------------------
          call create_array(return_array, src_distgrid, PDS%SrcMem,            &
                      PDS%Gfiles(iGfile)%src_grid(iG), localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating return array "     &
             // " with string "  // trim(adjustL(PDS%pds)) //                  &
             " with entry "  // trim(adjustL(liD)) // " of file " //           &
             trim(adjustL(PDS%Dfiles(iDfile)%filename))                        &
             // " and entry " // trim(adjustL(liG)) // " of file " //          &
             trim(adjustL(PDS%Gfiles(iGfile)%filename)),                       &
             rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! populate return array with zeros for redistribution test
          !---------------------------------------------------------------------
          call populate_array_value(return_array, initvalue, src_distgrid,     &
                  PDS%SrcMem, PDS%Gfiles(iGfile)%src_grid(iG), localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error initializing value in " //  &
             "return array ", rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! Create Destination distribution and array
          !---------------------------------------------------------------------
          call create_distribution(PDS%DstMem, PDS%Dfiles(iDfile)%dst_dist(iD),&
                    PDS%Gfiles(iGfile)%dst_grid(iG), dst_distgrid, VM, localrc)
          write(liG,"(i5)") iG
          write(liD,"(i5)") iD
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating source distgrid "  &
             // " with string "  // trim(adjustL(PDS%pds)) //                  &
             " with entry "  // trim(adjustL(liD)) // " of file " //           &
             trim(adjustL(PDS%Dfiles(iDfile)%filename))                        &
             // " and entry " // trim(adjustL(liG)) // " of file " //          &
             trim(adjustL(PDS%Gfiles(iGfile)%filename)),                       &
             rcToReturn=rc)) return

          call create_array(dst_array, dst_distgrid, PDS%DstMem,               &
                      PDS%Gfiles(iGfile)%dst_grid(iG), localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating destinationarray " &
             // " with string "  // trim(adjustL(PDS%pds)) //                  &
             " with entry "  // trim(adjustL(liD)) // " of file " //           &
             trim(adjustL(PDS%Dfiles(iDfile)%filename))                        &
             // " and entry " // trim(adjustL(liG)) // " of file " //          &
             trim(adjustL(PDS%Gfiles(iGfile)%filename)),                       &
             rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! populate destination array with zeros for redistribution test
          !---------------------------------------------------------------------
          call populate_array_value(dst_array, initvalue, dst_distgrid,        &
                  PDS%DstMem, PDS%Gfiles(iGfile)%dst_grid(iG), localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error initializing value in " //  &
             "destination array ", rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! Now conduct the redistribution test
  !
  ! the test consists of a forward redistribution from the source
  ! distribution to the destination distribution, and a second backward
  ! redistribution from the destination back to the source distribution.
  !-----------------------------------------------------------------------------
          !---------------------------------------------------------------------
          ! redistribution store for forward direction
          !---------------------------------------------------------------------
          call ESMF_ArrayRedistStore(srcArray=src_array, dstArray=dst_array,   &
                   routehandle=redistHandle_forward, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"Array redist store failed for" // &
                  " forward direction", rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! forward redistribution run
          !---------------------------------------------------------------------
          call ESMF_ArrayRedist(srcArray=src_array, dstArray=dst_array,        &
                   routehandle=redistHandle_forward, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"Array redist run failed for " //  &
                  " forward failed ", rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! release redistribution handles
          !---------------------------------------------------------------------
          call ESMF_ArrayRedistRelease(routehandle=redistHandle_forward,       &
                   rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"redistribution release for" //    &
                  " forward failed ", rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! redistribution store for reverse direction
          !---------------------------------------------------------------------
          call ESMF_ArrayRedistStore(srcArray=dst_array, dstArray=return_array,&
                   routehandle=redistHandle_reverse, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"Array redist store failed for" // &
                  " reverse direction", rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! forward redistribution run
          !---------------------------------------------------------------------
          call ESMF_ArrayRedist(srcArray=dst_array, dstArray=return_array,     &
                   routehandle=redistHandle_reverse, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"Array redist run failed for " //  &
                  " reverse failed ", rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! release redistribution handles
          !---------------------------------------------------------------------
          call ESMF_ArrayRedistRelease(routehandle=redistHandle_reverse,       &
                   rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"redistribution release for" //    &
                  " reverse failed ", rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! Check redistribution
  !-----------------------------------------------------------------------------
          !---------------------------------------------------------------------
          ! compare source array values with the return array values
          !---------------------------------------------------------------------
          call compare_redist_array(test_status,                               &
                  src_array, return_array, src_distgrid, src_distgrid,         &
                  PDS%SrcMem, PDS%Gfiles(iGfile)%src_grid(iG), localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"redistribution array " //         &
                  " comparison failed ", rcToReturn=rc)) return

! gblock - do we want to return on the compare failure?  How about internal ESMF error?
!   suspect already HarnessTest_FAILURE reported on compare error, ESMF_xxx on ESMF error

          PDS%test_record(iDfile,iGfile)%test_status(iD,iG) = test_status

          if( test_status == HarnessTest_FAILURE ) then
             test_failure = test_failure + 1
          endif

          call report_descriptor_string(PDS, iG, iD, iGfile, iDfile,           &
                                        reportType, localPET, localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"redistribution array " //         &
                  " test report failed ", rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! Clean up!!!!!!
  !-----------------------------------------------------------------------------
          !---------------------------------------------------------------------
          ! Destroy Array objects before moving to next test
          !---------------------------------------------------------------------
          call ESMF_ArrayDestroy(src_array, rc=localrc) ! original source
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"unable to destroy src_array",     &
             rcToReturn=rc)) return

          call ESMF_ArrayDestroy(return_array, rc=localrc) ! return to source
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"unable to destroy return_array",  &
             rcToReturn=rc)) return

          call ESMF_ArrayDestroy(dst_array, rc=localrc) ! redistribution
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"unable to destroy dst_array   ",  &
             rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! Destroy DistGrid objects before running next test
          !---------------------------------------------------------------------
          call ESMF_DistGridDestroy(src_distgrid, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"unable to destroy src_distgrid",  &
             rcToReturn=rc)) return

          call ESMF_DistGridDestroy(dst_distgrid, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"unable to destroy src_distgrid",  &
             rcToReturn=rc)) return

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

        enddo  ! iG
      enddo  ! iD
    enddo  ! iGfile
  enddo   ! iDfile
  !-----------------------------------------------------------------------------
  ! if I've gotten this far without an error, then the routine has succeeded.
  !-----------------------------------------------------------------------------
  rc = ESMF_SUCCESS

  if (localPet == 0) then
      print*,'Array Redist Completed'
  end if

  !-----------------------------------------------------------------------------
  end subroutine array_redist_test
  !-----------------------------------------------------------------------------

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

  !-----------------------------------------------------------------------------
  subroutine field_regrid_test(PDS, test_failure, reportType, VM, rc)
  !-----------------------------------------------------------------------------
  ! routine conducts the field regrid test
  !-----------------------------------------------------------------------------
  ! arguments
  type(problem_descriptor_strings), intent(inout) :: PDS
  character(THARN_MAXSTR), intent(in   ) :: reportType
  type(ESMF_VM), intent(in   ) :: VM
  integer, intent(inout) :: test_failure
  integer, intent(  out) :: rc

  ! local parameters
  real(ESMF_KIND_R8), parameter :: initvalue = 0.0

  ! local ESMF Types
  type(ESMF_Grid) :: gridSrc
  type(ESMF_Grid) :: gridDst
  type(ESMF_Field) :: srcField
  type(ESMF_Field) :: dstField
  type(ESMF_ArraySpec) :: SrcArraySpec
  type(ESMF_ArraySpec) :: DstArraySpec
  type(ESMF_DistGrid) :: src_distgrid, dst_distgrid
  type(ESMF_RouteHandle) :: routeHandle

  ! local integers
  integer :: localrc ! local error status
  integer :: iDfile, iGfile, iD, iG, ix
  integer :: test_status
  integer :: localPET
  integer :: libflag

  ! local characters
  character(THARN_MAXSTR) :: liG, liD

  ! debug
  ! real(ESMF_KIND_R8), pointer :: farrayPtr2(:,:)
  ! integer :: i1, i2, de, localDeCount, dimCount
  ! integer, allocatable ::  localDeToDeMap(:)
  ! type(ESMF_LocalArray), allocatable :: larrayList(:)
  ! integer, allocatable :: LBnd(:,:), UBnd(:,:)
  ! type(ESMF_Index_Flag) :: indexflag

  ! initialize return flag
  localrc = ESMF_RC_NOT_IMPL
  rc = ESMF_RC_NOT_IMPL

  ! initialize test counter
  test_failure = 0

  call ESMF_VMGet(VM, localPet=localPET, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"can not get local pet ", rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! for a single problem descriptor string, loop through each specifier file
  ! combination
  ! Create source and destination distributions, Fields and conduct regrid
  !-----------------------------------------------------------------------------
  if (localPet == 0) then
      print*,'-----------------======field regrid test==========-----------------------'
  end if

  do iDfile=1,PDS%nDfiles         ! distribution specifier files
    do iGfile=1,PDS%nGfiles       ! grid specifier files
      do iD=1, PDS%Dfiles(iDfile)%nDspecs   ! entries in distribution specifier
        do iG=1, PDS%Gfiles(iGfile)%nGspecs ! entries in grid specifier file
          write(liG,"(i5)") iG
          write(liD,"(i5)") iD

          if (localPet == 0) then
            print '(A)', "field regrid"  &
               // " with string " // trim(adjustL(PDS%pds)) //                   &
               " with entry "  // trim(adjustL(liD)) // " of file " //           &
               trim(adjustL(PDS%Dfiles(iDfile)%filename))                        &
               // " and entry " // trim(adjustL(liG)) // " of file " //          &
               trim(adjustL(PDS%Gfiles(iGfile)%filename))
          end if

          !---------------------------------------------------------------------
          ! create source distribution
          !---------------------------------------------------------------------
          call create_distribution(PDS%SrcMem, PDS%Dfiles(iDfile)%src_dist(iD),&
                    PDS%Gfiles(iGfile)%src_grid(iG), src_distgrid, VM, localrc)

          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating source distgrid "  &
             // " with string "  // trim(adjustL(PDS%pds)) //                  &
             " with entry "  // trim(adjustL(liD)) // " of file " //           &
             trim(adjustL(PDS%Dfiles(iDfile)%filename))                        &
             // " and entry " // trim(adjustL(liG)) // " of file " //          &
             trim(adjustL(PDS%Gfiles(iGfile)%filename)),                       &
             rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! create source grid from from distribution
          !---------------------------------------------------------------------
          call create_grid_from_distgrid(gridSrc, src_distgrid, PDS%SrcMem,    &
                      PDS%Gfiles(iGfile)%src_grid(iG),  &
                      PDS%Dfiles(iDfile)%src_dist(iD), localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating source array "     &
             // " with string "  // trim(adjustL(PDS%pds)) //                  &
             " with entry "  // trim(adjustL(liD)) // " of file " //           &
             trim(adjustL(PDS%Dfiles(iDfile)%filename))                        &
             // " and entry " // trim(adjustL(liG)) // " of file " //          &
             trim(adjustL(PDS%Gfiles(iGfile)%filename)),                       &
             rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! create array spec
          !---------------------------------------------------------------------
          !---------------------------------------------------------------------
          ! set the dimensionality of actual data storage to the memory size
          ! specified by the problem descriptor string
          !---------------------------------------------------------------------
          call ESMF_ArraySpecSet(SrcArraySpec, typekind=ESMF_TYPEKIND_R8,      &
                         rank=PDS%SrcMem%memRank, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating ArraySpecSet",     &
                         rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! create source field from grid and arrayspec
          !---------------------------------------------------------------------
          srcField = ESMF_FieldCreate(grid=gridSrc, arrayspec=SrcArraySpec,    &
                  staggerloc=ESMF_STAGGERLOC_CENTER, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating source field",     &
                  rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! populate src field with test function for regridding test
          !---------------------------------------------------------------------
          call populate_field(srcField, gridSrc, PDS%SrcMem,                   &
                   PDS%Gfiles(iGfile)%src_grid(iG),                            &
                   PDS%Gfiles(iGfile)%testfunction(iG), localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error initializing value in " //  &
             "source array ", rcToReturn=rc)) return

!-------------------------------------------------------------------------------
! Destination
!-------------------------------------------------------------------------------
          !print*,'field regrid create destination'
          !---------------------------------------------------------------------
          ! Create Destination distribution
          !---------------------------------------------------------------------
          call create_distribution(PDS%DstMem, PDS%Dfiles(iDfile)%dst_dist(iD),&
                    PDS%Gfiles(iGfile)%dst_grid(iG), dst_distgrid, VM, localrc)
          write(liG,"(i5)") iG
          write(liD,"(i5)") iD
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating source distgrid "  &
             // " with string "  // trim(adjustL(PDS%pds)) //                  &
             " with entry "  // trim(adjustL(liD)) // " of file " //           &
             trim(adjustL(PDS%Dfiles(iDfile)%filename))                        &
             // " and entry " // trim(adjustL(liG)) // " of file " //          &
             trim(adjustL(PDS%Gfiles(iGfile)%filename)),                       &
             rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! create destination grid from from distribution
          !---------------------------------------------------------------------
          call create_grid_from_distgrid(gridDst, dst_distgrid, PDS%DstMem,    &
                      PDS%Gfiles(iGfile)%dst_grid(iG),    &
                      PDS%Dfiles(iDfile)%dst_dist(iD), localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating source array "     &
             // " with string "  // trim(adjustL(PDS%pds)) //                  &
             " with entry "  // trim(adjustL(liD)) // " of file " //           &
             trim(adjustL(PDS%Dfiles(iDfile)%filename))                        &
             // " and entry " // trim(adjustL(liG)) // " of file " //          &
             trim(adjustL(PDS%Gfiles(iGfile)%filename)),                       &
             rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! create array spec
          !---------------------------------------------------------------------
          !---------------------------------------------------------------------
          ! set the dimensionality of actual data storage to the memory size
          ! specified by the problem descriptor string
          !---------------------------------------------------------------------
          call ESMF_ArraySpecSet(DstArraySpec, typekind=ESMF_TYPEKIND_R8,      &
                         rank=PDS%DstMem%memRank, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating dst ArraySpecSet", &
                         rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! create source field from grid and arrayspec
          !---------------------------------------------------------------------
          dstField = ESMF_FieldCreate(gridDst, DstArraySpec,                   &
                  staggerloc=ESMF_STAGGERLOC_CENTER, name="dest", rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating dst field",        &
                  rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  !-----------------------------------------------------------------------------
  !!!!!! NEED TO FIX THIS WHEN GRID AND MESH RECOGNIZE UNITS !!!!!!!
  !-----------------------------------------------------------------------------
  !-----------------------------------------------------------------------------
  ! check that the grid units agree. If they don't log an error. Eventually the
  ! mesh class should be able to reconcile different units.
  !-----------------------------------------------------------------------------
         do ix=1, PDS%Gfiles(iGfile)%src_grid(iG)%grank
           if( trim(PDS%Gfiles(iGfile)%src_grid(iG)%gunits(ix)%string) .ne.    &
               trim(PDS%Gfiles(iGfile)%dst_grid(iG)%gunits(ix)%string) ) then

               print*,'ERROR: source and destination grid units do not agree'
               print*,'Source units are: ',                                    &
                 trim(PDS%Gfiles(iGfile)%src_grid(iG)%gunits(ix)%string),      &
                 ' while destination units are: ',                             &
                 trim(PDS%Gfiles(iGfile)%dst_grid(iG)%gunits(ix)%string)

                call ESMF_LogSetError( ESMF_FAILURE, msg="Incompatible grid" //  &
                       " units.",rcToReturn=localrc)
                return
           endif
         enddo      ! ix

  !-----------------------------------------------------------------------------
  ! Now conduct the interpolation
  !
  ! the test consists of interpolating an analytical test function evaluated
  ! on a source grid onto a destination grid, and checking that the result
  ! agrees with the analytical solution to within a set tolerance.
  !-----------------------------------------------------------------------------
          !print*,'field regrid store'
          !---------------------------------------------------------------------
          ! select the correct regridding method and do a Field Regrid store
          !---------------------------------------------------------------------
          select case( PDS%process%tag )
             case( Harness_BilinearRegrid )
                call ESMF_FieldRegridStore(srcField, dstField=dstField, routeHandle=routeHandle,    &
                        regridmethod=ESMF_REGRIDMETHOD_BILINEAR, rc=localrc)
                if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"Field Bilinear Regrid " //  &
                        "store failed", rcToReturn=rc)) return

             case( Harness_PatchRegrid )
                libflag = 0  ! flag to catch if framework built w/ LAPACK and BLAS libs

#ifdef ESMF_LAPACK
                libflag = 1  !
                call ESMF_FieldRegridStore(srcField, dstField=dstField, routeHandle=routeHandle,    &
                        regridmethod=ESMF_REGRIDMETHOD_PATCH, rc=localrc)
                if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"Field Patch Regrid " // &
                        "store failed", rcToReturn=rc)) return
#endif

                if(libflag==0) call ESMF_LogSetError( ESMF_FAILURE, msg="Patch " // &
                       "regridding requires LAPACK & BLAS libraries. These" // &
                       " libraries appear not to have been set. The "//        &
                       " environment variable ESMF_LAPACK must be set ON," //  &
                       " and ESMF_LAPACK_LIBS set to the LAPACK and BLAS "//   &
                       " library paths",rcToReturn=localrc)

             case( Harness_ConservRegrid )
                call ESMF_LogSetError( ESMF_FAILURE, msg="Conservative " //      &
                       "regridding not currently supported",rcToReturn=localrc)
                return
             case( Harness_2ndConservRegrid )
                call ESMF_LogSetError( ESMF_FAILURE, msg="Conservative " //      &
                       "regridding not currently supported",rcToReturn=localrc)
                return
             case( Harness_NearNeighRegrid )
                call ESMF_LogSetError( ESMF_FAILURE, msg="Nearest Neighbor " //  &
                       "regridding not currently supported",rcToReturn=localrc)
                return
             case( Harness_Error )
               ! error - invalid regrid method
                call ESMF_LogSetError( ESMF_FAILURE, msg="Invalid regrid " //    &
                       "method.",rcToReturn=localrc)
             case default
               ! error
                call ESMF_LogSetError( ESMF_FAILURE, msg="Invalid regrid " //    &
                       "method.",rcToReturn=localrc)
          end select

          !---------------------------------------------------------------------
          ! regrid run
          !---------------------------------------------------------------------
          !print*,'field regrid run'
          call ESMF_FieldRegrid(srcField, dstField, routeHandle=routeHandle, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"Field Regrid run failed for " //  &
                  " forward failed ", rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! Check regrid
  !-----------------------------------------------------------------------------
          !print*,'check field regrid'
          !---------------------------------------------------------------------
          ! compare interpolated array values with the exact solution
          !---------------------------------------------------------------------
          call check_field(test_status, dstField, gridDst,                     &
                           PDS%Gfiles(iGfile)%dst_grid(iG),                    &
                           PDS%Gfiles(iGfile)%testfunction(iG), localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"redistribution array " //         &
                  " comparison failed ", rcToReturn=rc)) return

          PDS%test_record(iDfile,iGfile)%test_status(iD,iG) = test_status

          if( test_status == HarnessTest_FAILURE ) then
             test_failure = test_failure + 1
          endif

          call report_descriptor_string(PDS, iG, iD, iGfile, iDfile,           &
                                        reportType, localPET, localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"redistribution array " //         &
                  " test report failed ", rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! Clean up!!!
  !-----------------------------------------------------------------------------
          !---------------------------------------------------------------------
          ! release handles
          !---------------------------------------------------------------------
          call ESMF_FieldRegridRelease(routeHandle, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"Regrid routehandle Release failed",&
                 rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! release Fields
          !---------------------------------------------------------------------
          call ESMF_FieldDestroy(srcField, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"SRC Field Regrid Release failed", &
                 rcToReturn=rc)) return

          call ESMF_FieldDestroy(dstField, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"DST Field Regrid Release failed", &
                 rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! release Grids
          !---------------------------------------------------------------------
          call ESMF_GridDestroy(gridSrc, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"SRC grid Release failed",         &
                 rcToReturn=rc)) return

          call ESMF_GridDestroy(gridDst, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"DST Grid Release failed",         &
                 rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! Destroy DistGrid objects before running next test
          !---------------------------------------------------------------------
          call ESMF_DistGridDestroy(src_distgrid, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"unable to destroy src_distgrid",  &
             rcToReturn=rc)) return

          call ESMF_DistGridDestroy(dst_distgrid, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"unable to destroy src_distgrid",  &
             rcToReturn=rc)) return


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

        enddo  ! iG
      enddo  ! iD
    enddo  ! iGfile
  enddo   ! iDfile
  !-----------------------------------------------------------------------------
  ! if I've gotten this far without an error, then the routine has succeeded.
  !-----------------------------------------------------------------------------
  rc = ESMF_SUCCESS

  if (localPet == 0) then
      print*,'Regrid Completed'
  end if

  !-----------------------------------------------------------------------------
  end subroutine field_regrid_test
  !-----------------------------------------------------------------------------

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

  !-----------------------------------------------------------------------------
  subroutine field_redist_test(PDS, test_failure, reportType, VM, rc)
  !-----------------------------------------------------------------------------
  ! routine conducts the field redist test by redistributing from a source
  ! field to a destination and back again to the return field
  !-----------------------------------------------------------------------------
  ! arguments
  type(problem_descriptor_strings), intent(inout) :: PDS
  character(THARN_MAXSTR), intent(in   ) :: reportType
  type(ESMF_VM), intent(in   ) :: VM
  integer, intent(inout) :: test_failure
  integer, intent(  out) :: rc

  ! local parameters
  real(ESMF_KIND_R8), parameter :: initvalue = 0.0

  ! local ESMF Types
  type(ESMF_Grid) :: gridSrc
  type(ESMF_Grid) :: gridReturn
  type(ESMF_Grid) :: gridDst
  type(ESMF_Field) :: srcField
  type(ESMF_Field) :: dstField
  type(ESMF_Field) :: returnField
  type(ESMF_ArraySpec) :: SrcArraySpec
  type(ESMF_ArraySpec) :: DstArraySpec
  type(ESMF_DistGrid) :: src_distgrid, dst_distgrid
  type(ESMF_RouteHandle) :: routeHandle_forward
  type(ESMF_RouteHandle) :: routeHandle_backward

  ! local integers
  integer :: localrc ! local error status
  integer :: iDfile, iGfile, iD, iG
  integer :: test_status
  integer :: localPET
  ! integer :: libflag

  ! local characters
  character(THARN_MAXSTR) :: liG, liD

  ! debug
  ! real(ESMF_KIND_R8), pointer :: farrayPtr2(:,:)
  ! integer :: i1, i2, de, localDeCount, dimCount
  ! integer, allocatable ::  localDeToDeMap(:)
  ! type(ESMF_LocalArray), allocatable :: larrayList(:)
  ! integer, allocatable :: LBnd(:,:), UBnd(:,:)
  ! type(ESMF_Index_Flag) :: indexflag

  ! initialize return flag
  localrc = ESMF_RC_NOT_IMPL
  rc = ESMF_RC_NOT_IMPL
  ! Setting to fail per the Don's email of 3/9/09.
  test_status = HarnessTest_FAILURE

  ! initialize test counter
  test_failure = 0

  !-----------------------------------------------------------------------------
  ! for a single problem descriptor string, loop through each specifier file
  ! combination
  ! Create source and destination distributions, Fields and conduct regrid
  !-----------------------------------------------------------------------------
  print*,'-----------------======field regrid test==========-----------------------'

  do iDfile=1,PDS%nDfiles         ! distribution specifier files
    do iGfile=1,PDS%nGfiles       ! grid specifier files
      do iD=1, PDS%Dfiles(iDfile)%nDspecs   ! entries in distribution specifier
        do iG=1, PDS%Gfiles(iGfile)%nGspecs ! entries in grid specifier file
          !---------------------------------------------------------------------
          ! create source distribution
          !---------------------------------------------------------------------
          call create_distribution(PDS%SrcMem, PDS%Dfiles(iDfile)%src_dist(iD),&
                    PDS%Gfiles(iGfile)%src_grid(iG), src_distgrid, VM, localrc)
          write(liG,"(i5)") iG
          write(liD,"(i5)") iD
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating source distgrid "  &
             // " with string "  // trim(adjustL(PDS%pds)) //                  &
             " with entry "  // trim(adjustL(liD)) // " of file " //           &
             trim(adjustL(PDS%Dfiles(iDfile)%filename))                        &
             // " and entry " // trim(adjustL(liG)) // " of file " //          &
             trim(adjustL(PDS%Gfiles(iGfile)%filename)),                       &
             rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! create source grid from from distribution
          !---------------------------------------------------------------------
          call create_grid_from_distgrid(gridSrc, src_distgrid, PDS%SrcMem,    &
                      PDS%Gfiles(iGfile)%src_grid(iG),  &
                      PDS%Dfiles(iDfile)%src_dist(iD), localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating source array "     &
             // " with string "  // trim(adjustL(PDS%pds)) //                  &
             " with entry "  // trim(adjustL(liD)) // " of file " //           &
             trim(adjustL(PDS%Dfiles(iDfile)%filename))                        &
             // " and entry " // trim(adjustL(liG)) // " of file " //          &
             trim(adjustL(PDS%Gfiles(iGfile)%filename)),                       &
             rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! create array spec
          !---------------------------------------------------------------------
          !---------------------------------------------------------------------
          ! set the dimensionality of actual data storage to the memory size
          ! specified by the problem descriptor string
          !---------------------------------------------------------------------
          call ESMF_ArraySpecSet(SrcArraySpec, typekind=ESMF_TYPEKIND_R8,      &
                         rank=PDS%SrcMem%memRank, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating ArraySpecSet",     &
                         rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! create source field from grid and arrayspec
          !---------------------------------------------------------------------
          srcField = ESMF_FieldCreate(grid=gridSrc, arrayspec=SrcArraySpec,    &
                  staggerloc=ESMF_STAGGERLOC_CENTER, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating source field",     &
                  rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! populate src field with test function for regridding test
          !---------------------------------------------------------------------
!!!! need to populate as in array redist test

          !---------------------------------------------------------------------
          ! create return field from grid and arrayspec
          !---------------------------------------------------------------------
          returnField = ESMF_FieldCreate(grid=gridReturn, arrayspec=SrcArraySpec, &
                  staggerloc=ESMF_STAGGERLOC_CENTER, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating source field",     &
                  rcToReturn=rc)) return

!-------------------------------------------------------------------------------
! Destination
!-------------------------------------------------------------------------------
          !---------------------------------------------------------------------
          ! Create Destination distribution
          !---------------------------------------------------------------------
          call create_distribution(PDS%DstMem, PDS%Dfiles(iDfile)%dst_dist(iD),&
                    PDS%Gfiles(iGfile)%dst_grid(iG), dst_distgrid, VM, localrc)
          write(liG,"(i5)") iG
          write(liD,"(i5)") iD
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating source distgrid "  &
             // " with string "  // trim(adjustL(PDS%pds)) //                  &
             " with entry "  // trim(adjustL(liD)) // " of file " //           &
             trim(adjustL(PDS%Dfiles(iDfile)%filename))                        &
             // " and entry " // trim(adjustL(liG)) // " of file " //          &
             trim(adjustL(PDS%Gfiles(iGfile)%filename)),                       &
             rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! create destination grid from from distribution
          !---------------------------------------------------------------------
          call create_grid_from_distgrid(gridDst, dst_distgrid, PDS%DstMem,    &
                      PDS%Gfiles(iGfile)%dst_grid(iG),    &
                      PDS%Dfiles(iDfile)%src_dist(iD), localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating source array "     &
             // " with string "  // trim(adjustL(PDS%pds)) //                  &
             " with entry "  // trim(adjustL(liD)) // " of file " //           &
             trim(adjustL(PDS%Dfiles(iDfile)%filename))                        &
             // " and entry " // trim(adjustL(liG)) // " of file " //          &
             trim(adjustL(PDS%Gfiles(iGfile)%filename)),                       &
             rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! create array spec
          !---------------------------------------------------------------------
          !---------------------------------------------------------------------
          ! set the dimensionality of actual data storage to the memory size
          ! specified by the problem descriptor string
          !---------------------------------------------------------------------
          call ESMF_ArraySpecSet(DstArraySpec, typekind=ESMF_TYPEKIND_R8,      &
                         rank=PDS%DstMem%memRank, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating dst ArraySpecSet", &
                         rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! create source field from grid and arrayspec
          !---------------------------------------------------------------------
          dstField = ESMF_FieldCreate(gridDst, DstArraySpec,                   &
                  staggerloc=ESMF_STAGGERLOC_CENTER, name="dest", rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating dst field",        &
                  rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! Now conduct the forward redist test
  !-----------------------------------------------------------------------------
          ! forward redist
          call ESMF_FieldRedistStore(srcField, dstField, routeHandle_forward,  &
                        rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"Field Redist " //                 &
                        "store failed", rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! redist run
          !---------------------------------------------------------------------
          call ESMF_FieldRedist(srcField, dstField, routeHandle_forward,       &
                                rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"Field Redist run failed for " //  &
                  " forward failed ", rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! backward redist
  !-----------------------------------------------------------------------------
          call ESMF_FieldRedistStore(dstField, returnField,                    &
                                     routeHandle_backward, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"Field Redist " //                 &
                        "store failed", rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! redist run
          !---------------------------------------------------------------------
          call ESMF_FieldRedist(dstField, returnField, routeHandle_backward,   &
                                rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"Field Redist run failed for " //  &
                  " backward failed ", rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! Check redistribution
  !-----------------------------------------------------------------------------
          !---------------------------------------------------------------------
          !---------------------------------------------------------------------
!!!!! to do: check the redist - should be similar to the array redist check
!!!!! except that you need to extract the values from a field rather than an array

          PDS%test_record(iDfile,iGfile)%test_status(iD,iG) = test_status

          if( test_status == HarnessTest_FAILURE ) then
             test_failure = test_failure + 1
          endif

          call ESMF_VMGet(VM, localPet=localPET, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"can not get local pet ",          &
                  rcToReturn=rc)) return

          call report_descriptor_string(PDS, iG, iD, iGfile, iDfile,           &
                                        reportType, localPET, localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"redistribution array " //         &
                  " test report failed ", rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! Clean up!!!
  !-----------------------------------------------------------------------------
          !---------------------------------------------------------------------
          ! release handles
          !---------------------------------------------------------------------
          call ESMF_FieldRegridRelease(routeHandle_forward, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"Regrid routehandle Release failed",&
                 rcToReturn=rc)) return

          call ESMF_FieldRegridRelease(routeHandle_backward, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"Regrid routehandle Release failed",&
                 rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! release Fields
          !---------------------------------------------------------------------
          call ESMF_FieldDestroy(srcField, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"SRC Field Regrid Release failed", &
                 rcToReturn=rc)) return

          call ESMF_FieldDestroy(returnField, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"Return Field Regrid Release failed", &
                 rcToReturn=rc)) return

          call ESMF_FieldDestroy(dstField, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"DST Field Regrid Release failed", &
                 rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! release Grids
          !---------------------------------------------------------------------
          call ESMF_GridDestroy(gridSrc, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"SRC grid Release failed",         &
                 rcToReturn=rc)) return

          call ESMF_GridDestroy(gridDst, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"DST Grid Release failed",         &
                 rcToReturn=rc)) return

          !---------------------------------------------------------------------
          ! Destroy DistGrid objects before running next test
          !---------------------------------------------------------------------
          call ESMF_DistGridDestroy(src_distgrid, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"unable to destroy src_distgrid",  &
             rcToReturn=rc)) return

          call ESMF_DistGridDestroy(dst_distgrid, rc=localrc)
          if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"unable to destroy src_distgrid",  &
             rcToReturn=rc)) return


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

        enddo  ! iG
      enddo  ! iD
    enddo  ! iGfile
  enddo   ! iDfile
  !-----------------------------------------------------------------------------
  ! if I've gotten this far without an error, then the routine has succeeded.
  !-----------------------------------------------------------------------------
  rc = ESMF_SUCCESS

  print*,'Field Redist Completed'
  !-----------------------------------------------------------------------------
  end subroutine field_redist_test
  !-----------------------------------------------------------------------------


!-------------------------------------------------------------------------------
!===============================================================================
! Internal Methods
!===============================================================================
!-------------------------------------------------------------------------------


  !-----------------------------------------------------------------------------
  subroutine create_distribution(Memory, DistRecord, GridRecord, DistGrid,VM,rc)
  !-----------------------------------------------------------------------------
  ! routine creates a single distribution from specifier files
  !
  !-----------------------------------------------------------------------------
  ! arguments
  type(memory_config), intent(in   ) :: Memory
  type(dist_specification_record), intent(in   ) :: DistRecord
  type(grid_specification_record), intent(in   ) :: GridRecord
  type(ESMF_DistGrid), intent(  out) :: DistGrid
  type(ESMF_VM), intent(in   ) :: VM
  integer, intent(inout) :: rc

  ! local parameters
  integer :: localrc ! local error status
  integer :: allocRcToTest

  ! local integer variables
  integer :: k, nconnect
  integer, allocatable :: BIndx(:), EIndx(:)
  integer, allocatable :: decompOrder(:)
  type(ESMF_Decomp_Flag), allocatable :: decompType(:)
  type(ESMF_DistGridConnection), allocatable :: connectionList(:)
  integer, allocatable :: positionVector(:),orientationVector(:)

  ! local logicals
  logical :: noconnections

  ! initialize return flag
  localrc = ESMF_RC_NOT_IMPL
  rc = ESMF_RC_NOT_IMPL

  !-----------------------------------------------------------------------------
  ! allocate input arrays with size of the grid rank - since dist rank is now
  ! equal to the size of Grid Rank, with any dist missing dimensions set to one.
  !-----------------------------------------------------------------------------
  allocate( BIndx(Memory%GridRank), stat=allocRcToTest )
  if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "//    &
     " BIndx in create_distribution", rcToReturn=rc)) then
  endif
  allocate( EIndx(Memory%GridRank), stat=allocRcToTest )
  if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "//    &
     " EIndx in create_distribution", rcToReturn=rc)) then
  endif
  allocate( decompOrder(Memory%GridRank), stat=allocRcToTest )
  if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "//    &
     " decompOrder in create_distribution", rcToReturn=rc)) then
  endif
  allocate( decompType(Memory%GridRank), stat=allocRcToTest )
  if (ESMF_LogFoundAllocError(allocRcToTest, msg="Type "//                &
     " decompType in create_distribution", rcToReturn=rc)) then
  endif
  allocate( connectionList(1), stat=allocRcToTest )
  if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "//    &
     " connectionList in create_distribution", rcToReturn=rc)) then
  endif

  !-----------------------------------------------------------------------------
  ! fill input arrays:
  ! EIndx - filled with the grid sizes as specified by the grid specifier
  !         files, but in the order indicated by the problem descriptor strings
  ! decompOrder - filled with distribution sizes as specified by the dist
  !           specifier files, but in the order indicated by the PDStrings
  ! decompType - set to either ESMF_DECOMP_BALANCED or ESMF_DECOMP_CYCLIC
  !           depending on how its indicated in the problem descriptor string
  !-----------------------------------------------------------------------------
  nconnect = 0           ! assume number of connections is zero

! print*,' memory rank ',Memory%memRank
! print*,' grid rank',Memory%GridRank
  ! fill the array with gridRank number of elements
  do k=1,Memory%GridRank
    BIndx(k)   = 1
    EIndx(k) = GridRecord%gsize( Memory%GridOrder(k) )
  enddo  ! k

  ! if there are additional memory elements fill them with what is left over
! if( Memory%memRank > Memory%GridRank ) then
!   do k=Memory%GridRank+1,Memory%memRank
!     EIndx(k) = GridRecord%gsize( Memory%GridOrder(k) )
!   enddo  ! k
! endif

  ! pad the distribution with ones until its the same rank as the grid
  do k=1,Memory%DistRank
    decompOrder(k) = DistRecord%dsize( Memory%DistOrder(k) )
    decompType(k)  = ESMF_DECOMP_BALANCED
  enddo   ! k

  do k=Memory%DistRank+1, Memory%GridRank
    decompOrder(k) = 1
    decompType(k)  = ESMF_DECOMP_BALANCED
  enddo   ! k

  do k=1, Memory%DistRank
    !  assume the decomposition type is block unless block-cyclic is specified
    if( trim(adjustL(Memory%DistType(k)%string)) == "C" )  then
      decompType(k) = ESMF_DECOMP_CYCLIC
    endif

    ! look for periodic boundary conditions specified in the grid specifier file
    if( pattern_query(GridRecord%gtype(Memory%GridOrder(k))%string,            &
      "_periodic") /= 0 .or. pattern_query(                                    &
      GridRecord%gtype(Memory%GridOrder(k))%string,"_PERIODIC") /= 0)  then
      nconnect = nconnect + 1
    endif
  enddo  ! k

! print*,' mem rank ',Memory%memRank
! do k=1,Memory%GridRank
!   print*,k,' order/size ',Memory%GridOrder(k),decompOrder(k),EIndx(k)
! enddo
! print*,'        '
! print*,'record size dist ',DistRecord%dsize(1),DistRecord%dsize(2)
  !-----------------------------------------------------------------------------
  ! check for a connected domain - set connection call arguments
  !-----------------------------------------------------------------------------
  if( nconnect == 1 ) then
    ! singlely periodic domain
    noconnections = .FALSE.
    ! workspace
    allocate( positionVector(Memory%memRank), stat=allocRcToTest )
    if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "//        &
       " positionVector in create_distribution", rcToReturn=rc)) then
    endif
    allocate( orientationVector(Memory%memRank), stat=allocRcToTest )
    if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "//        &
       " orientationVector in create_distribution", rcToReturn=rc)) then
    endif

    do k=1, Memory%GridRank
      positionVector(k) = 0
      orientationVector(k) = k
      if( pattern_query(GridRecord%gtype(Memory%GridOrder(k))%string,          &
        "_periodic") /= 0 .or. pattern_query(                                  &
        GridRecord%gtype(Memory%GridOrder(k))%string,"_PERIODIC") /= 0)  then
        positionVector(k) = EIndx(k)
      endif
    enddo
  elseif( nconnect > 1 ) then
    ! multiply periodic domain
    noconnections = .FALSE.
      ! multiply connected domains are not currently supported
  else
    ! no tile connections specified
    noconnections = .TRUE.

  endif

  !-----------------------------------------------------------------------------
  ! create the distgrid
  !-----------------------------------------------------------------------------
  if( noconnections ) then
    ! no connection
    distgrid = ESMF_DistGridCreate(minIndex=BIndx, maxIndex=EIndx,             &
                   regDecomp=decompOrder, decompflag=decompType,               &
                   vm=VM, rc=localrc)
    if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating distgrid",               &
       rcToReturn=rc)) return

    !---------------------------------------------------------------------------
    ! debug
    !---------------------------------------------------------------------------
    if( debug_flag ) then
        print*,'==============Dist Grid Create info=============      '
        print*,' Min index ', BIndx
        print*,' Max index ', EIndx
        print*,' Decomp Order ', decompOrder
        print*,'      '
    endif
    !---------------------------------------------------------------------------
    ! debug
    !---------------------------------------------------------------------------

  else
    ! singlely periodic connection

    call ESMF_DistGridConnectionSet(connection=connectionList(1),              &
                                 tileIndexA=1, tileIndexB=1,                   &
                                 positionVector=positionVector,                &
                                 orientationVector=orientationVector,          &
                                 rc=localrc)

    distgrid = ESMF_DistGridCreate(minIndex=BIndx, maxIndex=EIndx,             &
                   regDecomp=decompOrder, decompflag=decompType,               &
                   connectionList=connectionList,rc=localrc)

  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating distgrid",                 &
             rcToReturn=rc)) return
    deallocate( positionVector,orientationVector )
  endif


  !-----------------------------------------------------------------------------
  ! clean up
  !-----------------------------------------------------------------------------
  deallocate( BIndx, EIndx )
  deallocate( decompOrder, decompType )
  deallocate( connectionList )

  !-----------------------------------------------------------------------------
  rc = ESMF_SUCCESS
  !-----------------------------------------------------------------------------

  !-----------------------------------------------------------------------------
  end subroutine create_distribution
  !-----------------------------------------------------------------------------

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

  !-----------------------------------------------------------------------------
  subroutine create_array(Array, DistGrid, Memory, Grid, rc)
  !-----------------------------------------------------------------------------
  ! routine creates a single distribution from specifier files
  !
  !-----------------------------------------------------------------------------
  ! arguments
  type(ESMF_Array), intent(  out) :: Array
  type(ESMF_DistGrid), intent(in   ) :: DistGrid
  type(memory_config), intent(in   ) :: Memory
  type(grid_specification_record), intent(in   ) :: Grid
  integer, intent(inout) :: rc

  ! local ESMF types
  type(ESMF_ArraySpec) :: ArraySpec

  ! local integer variables
  integer :: irank, k, tensorsize
  integer, allocatable :: haloL(:), haloR(:)
  integer, allocatable :: top(:), bottom(:)
  integer :: localrc ! local error status
  integer :: allocRcToTest

  ! local logicals
  logical :: nohaloflag


  ! initialize return flag
  localrc = ESMF_RC_NOT_IMPL
  rc = ESMF_RC_NOT_IMPL

  !-----------------------------------------------------------------------------
  ! set the dimensionality of actual data storage to the memory size specified
  ! by the problem descriptor string
  !-----------------------------------------------------------------------------
  call ESMF_ArraySpecSet(ArraySpec, typekind=ESMF_TYPEKIND_R8,                 &
                         rank=Memory%memRank, rc=localrc)

  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating ArraySpecSet",             &
                            rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! sanity check, make certain there are nonzero values for all distgrid dimensions
  !-----------------------------------------------------------------------------
! do k=1, Memory%DistRank
!    if( map(k) == 0 .or. map(k) > Memory%MemRank ) then
!       print*,'error - the inversion of DistOrder has failed',map(k)
!    endif
! enddo
! ! drs debug
! print*,' distgridto arraymap ',map
  ! drs debug

  !-----------------------------------------------------------------------------
  ! determine if halo is present
  !-----------------------------------------------------------------------------
  nohaloflag = .true.
  do irank=1, Memory%GridRank
     if( Memory%HaloL(irank) /= 0 ) nohaloflag = .false.
     if( Memory%HaloR(irank) /= 0 ) nohaloflag = .false.
  enddo   ! irank

  !-----------------------------------------------------------------------------
  ! if no halo specified, create array from ArraySpec object
  !-----------------------------------------------------------------------------
  if( nohaloflag ) then
!    print*,' no halos specified '
     !--------------------------------------------------------------------------
     ! assume that the GridRank=DistGridRank, by construction if the
     ! distGridRank < GridRank, we pad the distGrid with ones so that they are
     ! the same rank.
     !
     ! next if the MemoryRank = GridRank, there are no tensor dimensions (i.e.
     ! dimensions both not distributed nor associated with a grid), thus the
     ! undistLBound and undistUBound arguments need not be specified.
     !--------------------------------------------------------------------------
     if( Memory%memRank ==  Memory%GridRank ) then
        !-----------------------------------------------------------------------
        ! Memory Rank = Grid Rank
        !-----------------------------------------------------------------------
!       print*,'Memory Rank = Grid Rank ',Memory%memRank, ' = ', Memory%GridRank
        Array = ESMF_ArrayCreate(arrayspec=ArraySpec, distgrid=DistGrid,       &
                  indexflag=ESMF_INDEX_GLOBAL, rc=localrc)
        if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating non-haloed ESMF " // &
           "Array with no tensor dimensions", rcToReturn=rc)) return

     elseif( Memory%memRank > Memory%GridRank ) then
        !-----------------------------------------------------------------------
        ! Memory Rank > Grid Rank, so there are tensor dimensions
        !-----------------------------------------------------------------------
        tensorsize = Memory%memRank-Memory%GridRank
        allocate( top(tensorsize), stat=allocRcToTest )
        if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "//    &
           " top in create_array", rcToReturn=rc)) then
        endif
        allocate( bottom(tensorsize), stat=allocRcToTest )
        if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "//    &
           " bottom in create_array", rcToReturn=rc)) then
        endif

        print*,'Tensor dims ',tensorsize,' - Memory Rank > Grid Rank ',        &
               Memory%memRank, Memory%GridRank

        !-----------------------------------------------------------------------
        ! specify the bounds of the undistributed dimension(s).
        !-----------------------------------------------------------------------
        do k=Grid%grank,Grid%grank-tensorsize+1,-1
           bottom(k) = 1
           top(k) = Grid%gsize( Memory%GridOrder(k) )
        enddo  ! k

        Array = ESMF_ArrayCreate(arrayspec=ArraySpec, distgrid=DistGrid,       &
                  indexflag=ESMF_INDEX_GLOBAL,                                 &
                  undistLBound=bottom, undistUBound=top, rc=localrc)
        if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating non-haloed ESMF " // &
           "Array with tensor dimensions", rcToReturn=rc)) return

        deallocate( top, bottom )
     else
        print*,'error - Memory Rank < Grid Rank'
        call ESMF_LogSetError( ESMF_FAILURE, msg="memory rank < Grid rank not"// &
               "supported ",rcToReturn=localrc)
        return
     endif

  else
  !-----------------------------------------------------------------------------
  ! else if halo is specified, create an array with halo padding by setting
  ! totalLWith and totalRwidth
  !-----------------------------------------------------------------------------
     allocate( haloL(Memory%memRank), stat=allocRcToTest )
     if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "//       &
        " haloL in create_array", rcToReturn=rc)) then
     endif
     allocate( haloR(Memory%memRank), stat=allocRcToTest )
     if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "//       &
        " haloR in create_array", rcToReturn=rc)) then
     endif

     do k=1,Memory%GridRank
        haloL(k) = Memory%HaloL(k)
        haloR(k) = Memory%HaloR(k)
     enddo
     ! padd additional values so that array sizes matches memory rank
     do k=Memory%GridRank+1,Memory%memRank
        haloL(k) = 0
        haloR(k) = 0
     enddo

     !--------------------------------------------------------------------------
     ! assume that the GridRank=DistGridRank, by construction if the
     ! distGridRank < GridRank, we pad the distGrid with ones so that they are
     ! the same rank.
     !
     ! next if the MemoryRank = GridRank, there are no tensor dimensions (i.e.
     ! dimensions both not distributed nor associated with a grid), thus the
     ! undistLBound and undistUBound arguments need not be specified.
     !--------------------------------------------------------------------------
     if( Memory%memRank ==  Memory%GridRank ) then
        !-----------------------------------------------------------------------
        ! Memory Rank = Grid Rank
        !-----------------------------------------------------------------------
!       print*,'Memory Rank = Grid Rank ',Memory%memRank, Memory%GridRank
        Array = ESMF_ArrayCreate(arrayspec=ArraySpec, distgrid=DistGrid,       &
                     totalLWidth=HaloL, totalUWidth=HaloR,                     &
                     indexflag=ESMF_INDEX_GLOBAL, rc=localrc)

        if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating non-haloed ESMF " // &
                 "Array with no tensor dimensions", rcToReturn=rc)) return

     elseif( Memory%memRank > Memory%GridRank ) then
        !-----------------------------------------------------------------------
        ! Memory Rank > Grid Rank, so there are tensor dimensions
        !-----------------------------------------------------------------------
        tensorsize = Memory%memRank-Memory%GridRank
        allocate( top(tensorsize), stat=allocRcToTest )
        if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "//    &
           " top in create_array", rcToReturn=rc)) then
        endif
        allocate( bottom(tensorsize), stat=allocRcToTest )
        if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "//    &
           " bottom in create_array", rcToReturn=rc)) then
        endif

!       print*,'Tensor dims ',tensorsize,' - Memory Rank > Grid Rank ',        &
!              Memory%memRank, Memory%GridRank

        !-----------------------------------------------------------------------
        ! specify the bounds of the undistributed dimension(s).
        !-----------------------------------------------------------------------
        do k=Grid%grank,Grid%grank-tensorsize+1,-1
           bottom(k) = 1
           top(k) = Grid%gsize( Memory%GridOrder(k) )
        enddo  ! k

        Array = ESMF_ArrayCreate(arrayspec=ArraySpec, distgrid=DistGrid,       &
                     totalLWidth=HaloL, totalUWidth=HaloR,                     &
                     indexflag=ESMF_INDEX_GLOBAL,                              &
                     undistLBound=bottom, undistUBound=top, rc=localrc)

        if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating haloed ESMF " //     &
                 "Array with tensor dimensions", rcToReturn=rc)) return

        deallocate( top, bottom )
     else
!       print*,'error - Memory Rank < Grid Rank'
        call ESMF_LogSetError( ESMF_FAILURE, msg="memory rank < Grid rank not"// &
               "supported ",rcToReturn=localrc)
        return
     endif

     !--------------------------------------------------------------------------
     ! clean up
     !--------------------------------------------------------------------------
     deallocate( haloL, haloR )

  endif

  !-----------------------------------------------------------------------------
  rc = ESMF_SUCCESS
  !-----------------------------------------------------------------------------

  !-----------------------------------------------------------------------------
  end subroutine create_array
  !-----------------------------------------------------------------------------

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

  !-----------------------------------------------------------------------------
   subroutine create_grid_from_distgrid(Grid, DistGrid, Memory, Grid_info,     &
                                        Dist_info, rc)
  !-----------------------------------------------------------------------------
  ! routine creates a grid from an existing distribution and specifier files
  !-----------------------------------------------------------------------------
  ! arguments
  type(ESMF_Grid), intent(inout) :: Grid
  type(ESMF_DistGrid), intent(in   ) :: DistGrid
  type(memory_config), intent(in   ) :: Memory
  type(grid_specification_record), intent(in   ) :: Grid_info
  type(dist_specification_record), intent(in   ) :: Dist_info
  integer, intent(inout) :: rc

  ! local ESMF types

  ! local integer variables
  integer :: i,j,k
  ! integer :: l, m
  integer, allocatable :: lbnd(:), ubnd(:), maxI(:)
  integer :: localDECount, lDE, GridRank
  integer, allocatable :: decompOrder(:)

  integer :: localrc ! local error status

  ! local real variables
  real(ESMF_KIND_R8), pointer :: coordX2D(:,:), coordY2D(:,:)
  real(ESMF_KIND_R8), pointer :: coordX3D(:,:,:), coordY3D(:,:,:)
  real(ESMF_KIND_R8), pointer :: coordZ3D(:,:,:)

  ! initialize return flag
  localrc = ESMF_RC_NOT_IMPL
  rc = ESMF_RC_NOT_IMPL

  !-----------------------------------------------------------------------------
  ! cludge the distribution info
  !-----------------------------------------------------------------------------
  allocate( decompOrder(Memory%GridRank) )
  do k=1,Memory%DistRank
     decompOrder(k) = Dist_info%dsize( Memory%DistOrder(k) )
  enddo   ! k
  ! pad the distribution with ones until its the same rank as the grid
  do k=Memory%DistRank+1, Memory%GridRank
     decompOrder(k) = 1
  enddo   ! k

  !-----------------------------------------------------------------------------
  ! Create the Grid object from an existing distribution
  !-----------------------------------------------------------------------------
  select case(Grid_info%grank)
    case(2)
!     Grid = ESMF_GridCreate(distgrid=DistGrid, gridEdgeLWidth=(/ 0,0 /),      &
!                 gridEdgeUWidth =(/0,0/),  rc=localrc)
      allocate( maxI(Grid_info%grank) )
      maxI = Grid_info%gsize
      Grid = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=maxI,         &
                regDecomp=decompOrder, &
                coordSys=ESMF_COORDSYS_CART,                                      &
                indexflag=ESMF_INDEX_GLOBAL,                                   &
                gridEdgeLWidth=(/ 0,0 /),                                      &
                gridEdgeUWidth =(/0,0/),  rc=localrc)
      deallocate( maxI )

    case(3)
!     Grid = ESMF_GridCreate(distgrid=DistGrid, gridEdgeLWidth=(/0,0,0/),      &
!                 gridEdgeUWidth =(/0,0,0/),  rc=localrc)
      allocate( maxI(Grid_info%grank) )
      maxI = Grid_info%gsize
      Grid = ESMF_GridCreateNoPeriDim(minIndex=(/1,1,1/), maxIndex=maxI,       &
                regDecomp=decompOrder,                                         &
                coordSys=ESMF_COORDSYS_CART,                                      &
                indexflag=ESMF_INDEX_GLOBAL,                                   &
                gridEdgeLWidth=(/0,0,0/),                                      &
                gridEdgeUWidth =(/0,0,0/),  rc=localrc)
      deallocate( maxI )

    case default
      call ESMF_LogSetError(ESMF_FAILURE, msg="error in creating grid from distribution - unsupported rank", &
                    rcToReturn=rc)
      return
  end select

  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating grid from distribution",   &
                            rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! Get the number of local DEs
  !-----------------------------------------------------------------------------
  call ESMF_GridGet(grid=Grid, localDECount=localDECount, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting local DE count from grid",  &
                            rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! Get the number of local DEs
  !-----------------------------------------------------------------------------
  call ESMF_GridGet(grid=Grid, dimCount=GridRank, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting Grid rank from grid",       &
                            rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! allocate arrays to hold the local array bounds
  !-----------------------------------------------------------------------------
  allocate( lbnd(GridRank) )
  allocate( ubnd(GridRank) )

  !-----------------------------------------------------------------------------
  ! Allocate coordinates
  !-----------------------------------------------------------------------------
  call ESMF_GridAddCoord(Grid, staggerloc=ESMF_STAGGERLOC_CENTER, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error adding coord to grid",              &
                            rcToReturn=rc)) return

  do lDE=0,localDECount-1
    select case(GridRank)
      case(1)
      !-------------------------------------------------------------------------
      ! grid rank = 1
      !-------------------------------------------------------------------------
      localrc = ESMF_FAILURE
      call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank=1 not supported ",      &
                    rcToReturn=localrc)
      return

      case(2)
      !-------------------------------------------------------------------------
      ! grid rank = 2
      !-------------------------------------------------------------------------
      call ESMF_GridGetCoord(Grid, localDE=lDE,                                &
                   staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=1,              &
                   computationalLBound=lbnd, computationalUBound=ubnd,         &
                   farrayPtr=coordX2D, rc=localrc)
      if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting grid=1 coordinates",    &
                            rcToReturn=rc)) return

      call ESMF_GridGetCoord(Grid, localDE=lDE,                                &
                   staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=2,              &
                   computationalLBound=lbnd, computationalUBound=ubnd,         &
                   farrayPtr=coordY2D, rc=localrc)
      if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting grid=2 coordinates",    &
                            rcToReturn=rc)) return


      !-------------------------------------------------------------------------
      !  set coordinates
      !-------------------------------------------------------------------------
      do j=lbnd(2),ubnd(2)
         do i=lbnd(1),ubnd(1)
           coordX2D(i,j) = create_coord(i, Grid_info, 1, localrc)
           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting x coordinates",    &
                            rcToReturn=rc)) return

           coordY2D(i,j) = create_coord(j, Grid_info, 2, localrc)
           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting y coordinates",    &
                            rcToReturn=rc)) return
           !--------------------------------------------------------------------
           ! debug
           !--------------------------------------------------------------------
           if( debug_flag ) then
              print*,'coord values ',i,j,coordX2D(i,j),coordY2D(i,j)
           endif
           !--------------------------------------------------------------------
           ! debug
           !--------------------------------------------------------------------
         enddo    ! i loop
      enddo    ! j loop

      !-------------------------------------------------------------------------
      ! debug
      !-------------------------------------------------------------------------
      if( debug_flag ) then
         print*,'Set Coordinates'
         print*,'x/y(1,1)',coordX2D(lbnd(1),lbnd(2)),coordY2D(lbnd(1),lbnd(2))
         print*,'x/y(1,n)',coordX2D(lbnd(1),ubnd(2)),coordY2D(lbnd(1),ubnd(2))
        print*,'x/y(n,n)',coordX2D(ubnd(1),ubnd(2)),coordY2D(ubnd(1),ubnd(2))
      endif
      !-------------------------------------------------------------------------
      ! debug
      !-------------------------------------------------------------------------


      case(3)
      !-------------------------------------------------------------------------
      ! grid rank = 3
      !-------------------------------------------------------------------------
      call ESMF_GridGetCoord(Grid, localDE=lDE,                                &
                   staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=1,              &
                   computationalLBound=lbnd, computationalUBound=ubnd,         &
                   farrayPtr=coordX3D, rc=localrc)
      if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting grid=1 coordinates",    &
                            rcToReturn=rc)) return

      call ESMF_GridGetCoord(Grid, localDE=lDE,                                &
                   staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=2,              &
                   computationalLBound=lbnd, computationalUBound=ubnd,         &
                   farrayPtr=coordY3D, rc=localrc)
      if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting grid=2 coordinates",    &
                            rcToReturn=rc)) return

      call ESMF_GridGetCoord(Grid, localDE=lDE,                                &
                   staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=3,              &
                   computationalLBound=lbnd, computationalUBound=ubnd,         &
                   farrayPtr=coordZ3D, rc=localrc)
      if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting grid=3 coordinates",    &
                            rcToReturn=rc)) return

      !-------------------------------------------------------------------------
      !  set coordinates
      !-------------------------------------------------------------------------
      do k=lbnd(3),ubnd(3)
         do j=lbnd(2),ubnd(2)
            do i=lbnd(1),ubnd(1)
              coordX3D(i,j,k) = create_coord(i, Grid_info, 1, localrc)
              if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting x coordinates", &
                            rcToReturn=rc)) return
              coordY3D(i,j,k) = create_coord(j, Grid_info, 2, localrc)
              if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting y coordinates", &
                            rcToReturn=rc)) return
              coordZ3D(i,j,k) = create_coord(k, Grid_info, 3, localrc)
              if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting z coordinates", &
                            rcToReturn=rc)) return
            enddo    ! i loop
         enddo    ! j loop
      enddo    ! k loop

      case(4)
      !-------------------------------------------------------------------------
      ! grid rank = 4
      !-------------------------------------------------------------------------
          localrc = ESMF_FAILURE
           call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank=4 not supported ", &
                    rcToReturn=localrc)
           return

      case(5)
      !-------------------------------------------------------------------------
      ! grid rank = 5
      !-------------------------------------------------------------------------
          localrc = ESMF_FAILURE
           call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank=5 not supported ", &
                    rcToReturn=localrc)
           return

      case(6)
      !-------------------------------------------------------------------------
      ! grid rank = 6
      !-------------------------------------------------------------------------
          localrc = ESMF_FAILURE
           call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank=6 not supported ", &
                    rcToReturn=localrc)
           return

      case(7)
      !-------------------------------------------------------------------------
      ! grid rank = 7
      !-------------------------------------------------------------------------
           localrc = ESMF_FAILURE
           call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank=7 not supported ", &
                    rcToReturn=localrc)
           return
      case default
      !-------------------------------------------------------------------------
      ! error
      !-------------------------------------------------------------------------
           localrc = ESMF_FAILURE
           call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank not between 1 & 7",&
                    rcToReturn=localrc)
           return

      end select

   enddo    ! lDE

  !-----------------------------------------------------------------------------
  ! clean up
  !-----------------------------------------------------------------------------
  deallocate( lbnd, ubnd)
  deallocate( decompOrder )

  !-----------------------------------------------------------------------------
  rc = ESMF_SUCCESS
  !-----------------------------------------------------------------------------
  !-----------------------------------------------------------------------------
  end subroutine create_grid_from_distgrid
  !-----------------------------------------------------------------------------

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

  !-----------------------------------------------------------------------------
  subroutine populate_field(Field, Grid, Memory, Grid_info, TestFunction, rc)
  !-----------------------------------------------------------------------------
  ! routine populates the source field with the test function
  !-----------------------------------------------------------------------------
  ! arguments
  type(ESMF_Field), intent(inout) :: Field
  type(ESMF_Grid), intent(in   ) :: Grid
  type(memory_config), intent(in   ) :: Memory
  type(grid_specification_record), intent(in   ) :: Grid_info
  type(test_function_record), intent(in   ) :: TestFunction
  integer, intent(inout) :: rc

  ! local ESMF types

  ! local integer variables
  integer :: i,j,k
  ! integer :: l,m
  integer, allocatable :: lbnd(:), ubnd(:)
  integer :: localDECount, lDE, GridRank

  integer :: localrc ! local error status

  ! local real variables
  real(ESMF_KIND_R8) :: a, b, kx, ly, lenk, lenl
  ! real(ESMF_KIND_R8) :: exact
  real(ESMF_KIND_R8), pointer :: coordX2D(:,:), coordY2D(:,:)
  real(ESMF_KIND_R8), pointer :: exp2D(:,:)
  real(ESMF_KIND_R8), pointer :: coordX3D(:,:,:), coordY3D(:,:,:)
  real(ESMF_KIND_R8), pointer :: coordZ3D(:,:,:)
  real(ESMF_KIND_R8), pointer :: exp3D(:,:,:)

  ! initialize return flag
  localrc = ESMF_RC_NOT_IMPL
  rc = ESMF_RC_NOT_IMPL

  !-----------------------------------------------------------------------------
  ! Get the number of local DEs from the Grid
  !-----------------------------------------------------------------------------
  call ESMF_GridGet(grid=Grid, localDECount=localDECount, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting local DE count from grid",  &
                            rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! Get the grid rank
  !-----------------------------------------------------------------------------
  call ESMF_GridGet(grid=Grid, dimCount=GridRank, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting Grid rank from grid",       &
                            rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! allocate arrays to hold the local array bounds
  !-----------------------------------------------------------------------------
  allocate( lbnd(GridRank) )
  allocate( ubnd(GridRank) )


  !-----------------------------------------------------------------------------
  ! populate Field
  !-----------------------------------------------------------------------------

  do lDE=0,localDECount-1
    select case(GridRank)
      case(1)
      !-------------------------------------------------------------------------
      ! grid rank = 1
      !-------------------------------------------------------------------------
      localrc = ESMF_FAILURE
      call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank=1 not supported ",      &
                    rcToReturn=localrc)
      return

      case(2)
      !-------------------------------------------------------------------------
      ! grid rank = 2
      !-------------------------------------------------------------------------
      call ESMF_GridGetCoord(Grid, localDE=lDE,                                &
                   staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=1,              &
                   computationalLBound=lbnd, computationalUBound=ubnd,         &
                   farrayPtr=coordX2D, rc=localrc)
      if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting grid=1 coordinates",    &
                            rcToReturn=rc)) return

      call ESMF_GridGetCoord(Grid, localDE=lDE,                                &
                   staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=2,              &
                   computationalLBound=lbnd, computationalUBound=ubnd,         &
                   farrayPtr=coordY2D, rc=localrc)
      if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting grid=2 coordinates",    &
                            rcToReturn=rc)) return

      !-------------------------------------------------------------------------
      ! Get pointers to field array
      !-------------------------------------------------------------------------
      call ESMF_FieldGet(Field, lDE, exp2D, rc=localrc)
      if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error field get", rcToReturn=rc)) return

      !-------------------------------------------------------------------------
      !  set coordinates
      !-------------------------------------------------------------------------
      do j=lbnd(2),ubnd(2)
         do i=lbnd(1),ubnd(1)
           !-------------------------------------------------------------------
           select case( trim(TestFunction%string) )
             case("CONSTANT")
               exp2D(i,j) = TestFunction%param(1)

             case("COORDINATEX")
               exp2D(i,j) =  TestFunction%param(1)*coordX2D(i,j)

             case("COORDINATEY")
               exp2D(i,j) =  TestFunction%param(1)*coordY2D(i,j)

             case("SPHERICAL_HARMONIC")
              ! (a+b) + acos(k*2pi*x/Lx) + b*sin(l*2pi*y/Ly)
              a = TestFunction%param(1)
              kx = TestFunction%param(2)
              b = TestFunction%param(3)
              lY = TestFunction%param(4)
              lenk = Grid_info%grange(1,2) - Grid_info%grange(1,1)
              lenl = Grid_info%grange(2,2) - Grid_info%grange(2,1)
               exp2D(i,j) =  abs(a+b) +a*cos(pi2*kx*coordX2D(i,j)/lenk) +        &
                             b*sin(pi2*ly*coordY2D(i,j)/lenl)

             !case("PEAK_VALLEY")
             ! (1.-x*y)*sin(k*pi*x/Lx)*cos(l*pi*y)+2.

             case default
               ! error
                call ESMF_LogSetError( ESMF_FAILURE, msg="undefined case in select statement",    &
                       rcToReturn=localrc)
                return
           end select
           !-------------------------------------------------------------------
         enddo    ! i loop
      enddo    ! j loop

      case(3)
      !-------------------------------------------------------------------------
      ! grid rank = 3
      !-------------------------------------------------------------------------
      call ESMF_GridGetCoord(Grid, localDE=lDE,                                &
                   staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=1,              &
                   computationalLBound=lbnd, computationalUBound=ubnd,         &
                   farrayPtr=coordX3D, rc=localrc)
      if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting grid=1 coordinates",    &
                            rcToReturn=rc)) return

      call ESMF_GridGetCoord(Grid, localDE=lDE,                                &
                   staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=2,              &
                   computationalLBound=lbnd, computationalUBound=ubnd,         &
                   farrayPtr=coordY3D, rc=localrc)
      if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting grid=2 coordinates",    &
                            rcToReturn=rc)) return

      call ESMF_GridGetCoord(Grid, localDE=lDE,                                &
                   staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=3,              &
                   computationalLBound=lbnd, computationalUBound=ubnd,         &
                   farrayPtr=coordZ3D, rc=localrc)
      if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting grid=3 coordinates",    &
                            rcToReturn=rc)) return

      !-------------------------------------------------------------------------
      ! Get pointers to field array
      !-------------------------------------------------------------------------
     call ESMF_FieldGet(Field, lDE, exp3D, rc=localrc)
      if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error field get", rcToReturn=rc)) return

      !-------------------------------------------------------------------------
      !  set coordinates
      !-------------------------------------------------------------------------
      do k=lbnd(3),ubnd(3)
         do j=lbnd(2),ubnd(2)
            do i=lbnd(1),ubnd(1)
           !-------------------------------------------------------------------
           select case( trim(TestFunction%string) )
             case("CONSTANT")
               exp3D(i,j,k) = TestFunction%param(1)

             case("COORDINATEX")
               exp3D(i,j,k) =  TestFunction%param(1)*coordX3D(i,j,k)

             case("COORDINATEY")
               exp3D(i,j,k) =  TestFunction%param(1)*coordY3D(i,j,k)

             case("COORDINATEZ")
               exp3D(i,j,k) =  TestFunction%param(1)*coordZ3D(i,j,k)

             case default
               ! error
                call ESMF_LogSetError( ESMF_FAILURE, msg="undefined case in select statement",    &
                       rcToReturn=localrc)
                return
           end select
           !-------------------------------------------------------------------
            ! coordX3D(i,j,k)
            ! coordY3D(i,j,k)
            ! coordZ3D(i,j,k)
            enddo    ! i loop
         enddo    ! j loop
      enddo    ! k loop

      case(4)
      !-------------------------------------------------------------------------
      ! grid rank = 4
      !-------------------------------------------------------------------------
          localrc = ESMF_FAILURE
           call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank=4 not supported ", &
                    rcToReturn=localrc)
           return

      case(5)
      !-------------------------------------------------------------------------
      ! grid rank = 5
      !-------------------------------------------------------------------------
          localrc = ESMF_FAILURE
           call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank=5 not supported ", &
                    rcToReturn=localrc)
           return

      case(6)
      !-------------------------------------------------------------------------
      ! grid rank = 6
      !-------------------------------------------------------------------------
          localrc = ESMF_FAILURE
           call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank=6 not supported ", &
                    rcToReturn=localrc)
           return

      case(7)
      !-------------------------------------------------------------------------
      ! grid rank = 7
      !-------------------------------------------------------------------------
           localrc = ESMF_FAILURE
           call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank=7 not supported ", &
                    rcToReturn=localrc)
           return
      case default
      !-------------------------------------------------------------------------
      ! error
      !-------------------------------------------------------------------------
           localrc = ESMF_FAILURE
           call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank not between 1 & 7",&
                    rcToReturn=localrc)
           return

      end select

   enddo    ! lDE
  !-----------------------------------------------------------------------------
  !-----------------------------------------------------------------------------
  ! clean up
  !-----------------------------------------------------------------------------

  deallocate( lbnd, ubnd)

  !-----------------------------------------------------------------------------
  rc = ESMF_SUCCESS
  !-----------------------------------------------------------------------------

  !-----------------------------------------------------------------------------
  end subroutine populate_field
  !-----------------------------------------------------------------------------

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

  !-----------------------------------------------------------------------------
  subroutine check_field(test_status, Field, Grid, Grid_info, TestFunction, rc)
  !-----------------------------------------------------------------------------
  ! routine checks destination field against analytical solution evaluated at
  ! the destination grid points
  !-----------------------------------------------------------------------------
  ! arguments
  integer, intent(inout) :: test_status
  type(ESMF_Field), intent(inout) :: Field
  type(ESMF_Grid), intent(in   ) :: Grid
  type(grid_specification_record), intent(in   ) :: Grid_info
  type(test_function_record), intent(in   ) :: TestFunction
  integer, intent(inout) :: rc

  ! local ESMF types

  ! local integer variables
  integer :: i,j,k
  ! integer :: l,m
  integer, allocatable :: lbnd(:), ubnd(:)
  integer :: localDECount, lDE, GridRank

  integer :: localrc ! local error status

  ! local real variables
  real(ESMF_KIND_R8) :: a, b, kx, ly, lenk, lenl, exact

  real(ESMF_KIND_R8), pointer :: coordX2D(:,:), coordY2D(:,:)
  real(ESMF_KIND_R8), pointer :: interp2D(:,:)
  real(ESMF_KIND_R8), pointer :: coordX3D(:,:,:), coordY3D(:,:,:)
  real(ESMF_KIND_R8), pointer :: coordZ3D(:,:,:)
  real(ESMF_KIND_R8), pointer :: interp3D(:,:,:)

  ! initialize return flag
  test_status = HarnessTest_SUCCESS
  localrc = ESMF_RC_NOT_IMPL
  rc = ESMF_RC_NOT_IMPL

  !-----------------------------------------------------------------------------
  ! Get the number of local DEs from the Grid
  !-----------------------------------------------------------------------------
  call ESMF_GridGet(grid=Grid, localDECount=localDECount, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting local DE count from grid",  &
                            rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! Get the grid rank
  !-----------------------------------------------------------------------------
  call ESMF_GridGet(grid=Grid, dimCount=GridRank, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting Grid rank from grid",       &
                            rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! allocate arrays to hold the local array bounds
  !-----------------------------------------------------------------------------
  allocate( lbnd(GridRank) )
  allocate( ubnd(GridRank) )


  !-----------------------------------------------------------------------------
  ! check Field
  !-----------------------------------------------------------------------------

  do lDE=0,localDECount-1
    select case(GridRank)
      case(1)
      !-------------------------------------------------------------------------
      ! grid rank = 1
      !-------------------------------------------------------------------------
      localrc = ESMF_FAILURE
      call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank=1 not supported ",      &
                    rcToReturn=localrc)
      return

      case(2)
      !-------------------------------------------------------------------------
      ! grid rank = 2
      !-------------------------------------------------------------------------
      call ESMF_GridGetCoord(Grid, localDE=lDE,                                &
                   staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=1,              &
                   computationalLBound=lbnd, computationalUBound=ubnd,         &
                   farrayPtr=coordX2D, rc=localrc)
      if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting grid=1 coordinates",    &
                            rcToReturn=rc)) return

      call ESMF_GridGetCoord(Grid, localDE=lDE,                                &
                   staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=2,              &
                   computationalLBound=lbnd, computationalUBound=ubnd,         &
                   farrayPtr=coordY2D, rc=localrc)
      if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting grid=2 coordinates",    &
                            rcToReturn=rc)) return

      !-------------------------------------------------------------------------
      ! Get pointers to field array
      !-------------------------------------------------------------------------
      call ESMF_FieldGet(Field, lDE, interp2D, rc=localrc)
      if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error field get", rcToReturn=rc)) return

      !-------------------------------------------------------------------------
      !  compute relative error
      !-------------------------------------------------------------------------
      do j=lbnd(2),ubnd(2)
         do i=lbnd(1),ubnd(1)
           !-------------------------------------------------------------------
           select case( trim(TestFunction%string) )
             case("CONSTANT")
               if (.not. check_value (TestFunction%param(1), interp2D(i,j), TestFunction%param(2))) then
                 test_status = HarnessTest_FAILURE
                 print *,' fields disagree ',i,j,interp2D(i,j),                &
                          TestFunction%param(1)
               endif

             case("COORDINATEX")
               if (.not. check_value (TestFunction%param(1)*coordX2D(i,j), interp2D(i,j), &
                 TestFunction%param(2))) then
                   test_status = HarnessTest_FAILURE
                   print*,' fields disagree ',i,j,interp2D(i,j),                &
                          TestFunction%param(1)*coordX2D(i,j)
               endif

             case("COORDINATEY")
               if (.not. check_value (TestFunction%param(1)*coordY2D(i,j), interp2D(i,j), &
                 TestFunction%param(2))) then
                   test_status = HarnessTest_FAILURE
                   print*,' fields disagree ',i,j,interp2D(i,j),                &
                          TestFunction%param(1)*coordY2D(i,j)
               endif

             case("SPHERICAL_HARMONIC")
              ! (a+b) + acos(k*2pi*x/Lx) + b*sin(l*2pi*y/Ly)
              a = TestFunction%param(1)
              kx = TestFunction%param(2)
              b = TestFunction%param(3)
              ly = TestFunction%param(4)
              lenk = Grid_info%grange(1,2) - Grid_info%grange(1,1)
              lenl = Grid_info%grange(2,2) - Grid_info%grange(2,1)
              exact = abs(a+b) +a*cos(pi2*kx*coordX2D(i,j)/lenk) +        &
                             b*sin(pi2*ly*coordY2D(i,j)/lenl)

              if (.not. check_value (exact, interp2D(i,j), TestFunction%param(5))) then
                 test_status = HarnessTest_FAILURE
                 print*,' fields disagree ',i,j,interp2D(i,j), exact
               endif

             case("PEAK_VALLEY")
                ! (1.-x*y)*sin(k*pi*x/Lx)*cos(l*pi*y)+2.
               test_status = HarnessTest_FAILURE
               print *, 'test function PEAK_VALLEY not implemented'

             case default
               test_status = HarnessTest_FAILURE
               print *, 'undefined test function ',trim(TestFunction%string)

           end select
           !-------------------------------------------------------------------
         enddo    ! i loop
      enddo    ! j loop

      case(3)
      !-------------------------------------------------------------------------
      ! grid rank = 3
      !-------------------------------------------------------------------------
      call ESMF_GridGetCoord(Grid, localDE=lDE,                                &
                   staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=1,              &
                   computationalLBound=lbnd, computationalUBound=ubnd,         &
                   farrayPtr=coordX3D, rc=localrc)
      if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting grid=1 coordinates",    &
                            rcToReturn=rc)) return

      call ESMF_GridGetCoord(Grid, localDE=lDE,                                &
                   staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=2,              &
                   computationalLBound=lbnd, computationalUBound=ubnd,         &
                   farrayPtr=coordY3D, rc=localrc)
      if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting grid=2 coordinates",    &
                            rcToReturn=rc)) return

      call ESMF_GridGetCoord(Grid, localDE=lDE,                                &
                   staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=3,              &
                   computationalLBound=lbnd, computationalUBound=ubnd,         &
                   farrayPtr=coordZ3D, rc=localrc)
      if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting grid=3 coordinates",    &
                            rcToReturn=rc)) return

      !-------------------------------------------------------------------------
      ! Get pointers to field array
      !-------------------------------------------------------------------------
      call ESMF_FieldGet(Field, lDE, interp3D, rc=localrc)
      if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error field get", rcToReturn=rc)) return

      !-------------------------------------------------------------------------
      !  check all values
      !-------------------------------------------------------------------------
      do k=lbnd(3),ubnd(3)
         do j=lbnd(2),ubnd(2)
            do i=lbnd(1),ubnd(1)
           !-------------------------------------------------------------------
           select case( trim(TestFunction%string) )
             case("CONSTANT")
               if (.not. check_value (TestFunction%param(1), interp3D(i,j,k), TestFunction%param(2))) then
                 test_status = HarnessTest_FAILURE
                 print*,' fields disagree ',i,j,k,interp3D(i,j,k),            &
                          TestFunction%param(1)
               endif

             case("COORDINATEX")
               if (.not. check_value (TestFunction%param(1)*coordX3D(i,j,k), interp3D(i,j,k), &
                 TestFunction%param(2))) then
                   test_status = HarnessTest_FAILURE
                   print*,' fields disagree ',i,j,k,interp3D(i,j,k),            &
                        TestFunction%param(1)*coordX3D(i,j,k)
               endif

             case("COORDINATEY")
               if (.not. check_value (TestFunction%param(1)*coordY3D(i,j,k), interp3D(i,j,k), &
                 TestFunction%param(2))) then
                   test_status = HarnessTest_FAILURE
                   print*,' fields disagree ',i,j,k,interp3D(i,j,k),            &
                        TestFunction%param(1)*coordY3D(i,j,k)
               endif

             case("COORDINATEZ")
               if (.not. check_value (TestFunction%param(1)*coordZ3D(i,j,k), interp3D(i,j,k), &
                 TestFunction%param(2))) then
                   test_status = HarnessTest_FAILURE
                   print*,' fields disagree ',i,j,k,interp3D(i,j,k),            &
                        TestFunction%param(1)*coordZ3D(i,j,k)
               endif

             case default
               test_status = HarnessTest_FAILURE
               print *, 'undefined test function ',trim(TestFunction%string)

           end select
           !-------------------------------------------------------------------
            enddo    ! i loop
         enddo    ! j loop
      enddo    ! k loop

      case(4)
      !-------------------------------------------------------------------------
      ! grid rank = 4
      !-------------------------------------------------------------------------
          localrc = ESMF_FAILURE
           call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank=4 not supported ", &
                    rcToReturn=localrc)
           return

      case(5)
      !-------------------------------------------------------------------------
      ! grid rank = 5
      !-------------------------------------------------------------------------
          localrc = ESMF_FAILURE
           call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank=5 not supported ", &
                    rcToReturn=localrc)
           return

      case(6)
      !-------------------------------------------------------------------------
      ! grid rank = 6
      !-------------------------------------------------------------------------
          localrc = ESMF_FAILURE
           call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank=6 not supported ", &
                    rcToReturn=localrc)
           return

      case(7)
      !-------------------------------------------------------------------------
      ! grid rank = 7
      !-------------------------------------------------------------------------
           localrc = ESMF_FAILURE
           call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank=7 not supported ", &
                    rcToReturn=localrc)
           return
      case default
      !-------------------------------------------------------------------------
      ! error
      !-------------------------------------------------------------------------
           localrc = ESMF_FAILURE
           call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank not between 1 & 7",&
                    rcToReturn=localrc)
           return

      end select

   enddo    ! lDE
  !-----------------------------------------------------------------------------
  !-----------------------------------------------------------------------------
  ! clean up
  !-----------------------------------------------------------------------------

  deallocate( lbnd, ubnd)

  !-----------------------------------------------------------------------------
  rc = ESMF_SUCCESS
  !-----------------------------------------------------------------------------

  !-----------------------------------------------------------------------------
  end subroutine check_field
  !-----------------------------------------------------------------------------

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

  !-----------------------------------------------------------------------------
  subroutine populate_redist_array(Array, DistGrid, Memory, Grid, rc)
  !-----------------------------------------------------------------------------
  ! routine populates an esmf array to the values used for a redist test. These
  ! values are dependent on the global coordinates and the local DE number. For
  ! a rank 2 array the values are set to Value = localDE + 1000*i1 + 1/1000 *i2
  !
  !-----------------------------------------------------------------------------
  ! arguments
  type(ESMF_Array), intent(inout) :: Array
  type(ESMF_DistGrid), intent(in   ) :: DistGrid
  type(memory_config), intent(in   ) :: Memory
  type(grid_specification_record), intent(in   ) :: Grid
  integer, intent(inout) :: rc

  ! local ESMF types
  type(ESMF_LocalArray), allocatable :: larrayList(:)
  type(ESMF_Index_Flag) :: indexflag

  ! local parameters
  integer :: localrc ! local error status

  ! local integer variables
  integer :: de, localDeCount, dimCount
  integer, allocatable ::  localDeToDeMap(:)
  integer, allocatable :: LBnd(:,:), UBnd(:,:)
  integer :: i1, i2, i3, i4, i5, i6, i7
  ! integer :: irank, k, tensorsize, fsize(7)
  ! integer, allocatable :: haloL(:), haloR(:)
  ! integer, allocatable :: top(:), bottom(:)
  integer :: allocRcToTest

  ! local real variables
  real(ESMF_KIND_R8), pointer :: farrayPtr1(:), farrayPtr2(:,:)
  real(ESMF_KIND_R8), pointer :: farrayPtr3(:,:,:)
  real(ESMF_KIND_R8), pointer :: farrayPtr4(:,:,:,:)
  real(ESMF_KIND_R8), pointer :: farrayPtr5(:,:,:,:,:)
  real(ESMF_KIND_R8), pointer :: farrayPtr6(:,:,:,:,:,:)
  real(ESMF_KIND_R8), pointer :: farrayPtr7(:,:,:,:,:,:,:)

  ! initialize return flag
  localrc = ESMF_RC_NOT_IMPL
  rc = ESMF_RC_NOT_IMPL

  !-----------------------------------------------------------------------------
  ! get local array DE list
  !-----------------------------------------------------------------------------
  call ESMF_ArrayGet(array, localDeCount=localDeCount, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting local DE count from array", &
          rcToReturn=rc)) return

  allocate(localDeToDeMap(localDeCount), stat=allocRcToTest)
  if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "//          &
     " localDeToDeMap in populate_redist_array", rcToReturn=rc)) then
  endif
  call ESMF_ArrayGet(array, localDeToDeMap=localDeToDeMap, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting local DE list from array",  &
          rcToReturn=rc)) return

  allocate(larrayList(localDeCount), stat=allocRcToTest)
  if (ESMF_LogFoundAllocError(allocRcToTest, msg="type "//                      &
     " larrayList in populate_redist_array", rcToReturn=rc)) then
  endif
  call ESMF_ArrayGet(array, localarrayList=larrayList, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting local array list",          &
          rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! get dimcount to allocate bound arrays
  !-----------------------------------------------------------------------------
  call ESMF_DistGridGet(DistGrid, dimCount=dimCount, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting dimCount from distGrid",    &
          rcToReturn=rc)) return

  allocate(UBnd(dimCount, localDeCount), stat=allocRcToTest )
  if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "//          &
     " UBnd in populate_redist_array", rcToReturn=rc)) then
  endif
  allocate(LBnd(dimCount, localDeCount), stat=allocRcToTest )
  if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "//          &
     " LBnd in populate_redist_array", rcToReturn=rc)) then
  endif

  call ESMF_ArrayGet(array, indexflag=indexflag,                               &
           exclusiveLBound=LBnd, exclusiveUBound=UBnd, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting exclusive bound range",     &
          rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! associate the fortran pointer with the array object and populate the array
  !-----------------------------------------------------------------------------

  !-----------------------------------------------------------------------------
  ! Memory Rank = Grid Rank, then there are no tensor dimensions
  !-----------------------------------------------------------------------------
  if( Memory%memRank ==  Memory%GridRank ) then

     select case(dimCount)
     case(1)
     !--------------------------------------------------------------------------
     ! rank = 1
     !--------------------------------------------------------------------------
        do de=1, localDeCount
           call ESMF_LocalArrayGet(larrayList(de), farrayPtr=farrayPtr1, &
                                   datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)
           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                   "array list", rcToReturn=rc)) return

           do i1=LBnd(1,de), UBnd(1,de)
              farrayPtr1(i1) = localDeToDeMap(de) + 1000.0d0*i1
           enddo    !   i1
        enddo    ! de
     case(2)
     !--------------------------------------------------------------------------
     ! rank = 2
     !--------------------------------------------------------------------------
        do de=1, localDeCount
           call ESMF_LocalArrayGet(larrayList(de), farrayPtr=farrayPtr2, &
                                   datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)
           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                   "array list", rcToReturn=rc)) return

           do i1=LBnd(1,de), UBnd(1,de)
              do i2=LBnd(2,de), UBnd(2,de)
                 farrayPtr2(i1,i2) = localDeToDeMap(de) + 1000.0d0*i1 + 0.001d0*i2
              enddo   !   i2
           enddo    !   i1
        enddo    ! de
     case(3)
     !--------------------------------------------------------------------------
     ! rank = 3
     !--------------------------------------------------------------------------
        do de=1, localDeCount
           call ESMF_LocalArrayGet(larrayList(de), farrayPtr=farrayPtr3, &
                                   datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)
           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                   "array list", rcToReturn=rc)) return

           do i1=LBnd(1,de), UBnd(1,de)
              do i2=LBnd(2,de), UBnd(2,de)
                 do i3=LBnd(3,de), UBnd(3,de)
                    farrayPtr3(i1,i2,i3) = localDeToDeMap(de) + 1.0d4*i1 + 10.0d2*i2 &
                          + 1.0d-2*i3
                 enddo   !   i3
              enddo   !   i2
           enddo    !   i1
        enddo    ! de
     case(4)
     !--------------------------------------------------------------------------
     ! rank = 4
     !--------------------------------------------------------------------------
        do de=1, localDeCount
           call ESMF_LocalArrayGet(larrayList(de), farrayPtr=farrayPtr4, &
                                   datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)
           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                   "array list", rcToReturn=rc)) return

           do i1=LBnd(1,de), UBnd(1,de)
              do i2=LBnd(2,de), UBnd(2,de)
                 do i3=LBnd(3,de), UBnd(3,de)
                    do i4=LBnd(4,de), UBnd(4,de)
                       farrayPtr4(i1,i2,i3,i4) = localDeToDeMap(de) + 1.0d4*i1         &
                             + 1.0d2*i2 + 1.0d-2*i3 + 1.0d-4*i4
                    enddo   !   i4
                 enddo   !   i3
              enddo   !   i2
           enddo    !   i1
        enddo    ! de
#ifndef ESMF_NO_GREATER_THAN_4D
     case(5)
     !--------------------------------------------------------------------------
     ! rank = 5
     !--------------------------------------------------------------------------
        do de=1, localDeCount
           call ESMF_LocalArrayGet(larrayList(de), farrayPtr=farrayPtr5, &
                                   datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)
           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                   "array list", rcToReturn=rc)) return

           do i1=LBnd(1,de), UBnd(1,de)
              do i2=LBnd(2,de), UBnd(2,de)
                 do i3=LBnd(3,de), UBnd(3,de)
                    do i4=LBnd(4,de), UBnd(4,de)
                       do i5=LBnd(5,de), UBnd(5,de)
                          farrayPtr5(i1,i2,i3,i4,i5) = localDeToDeMap(de) + 1.0d4*i1   &
                             + 1.0d2*i2 + 1.0d0*i3 + 1.0d-2*i4  + 1.0d-4*i5
                       enddo   !   i5
                    enddo   !   i4
                 enddo   !   i3
              enddo   !   i2
           enddo    !   i1
        enddo    ! de
     case(6)
     !--------------------------------------------------------------------------
     ! rank = 6
     !--------------------------------------------------------------------------
        do de=1, localDeCount
           call ESMF_LocalArrayGet(larrayList(de), farrayPtr=farrayPtr6, &
                                   datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)
           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                   "array list", rcToReturn=rc)) return

           do i1=LBnd(1,de), UBnd(1,de)
              do i2=LBnd(2,de), UBnd(2,de)
                 do i3=LBnd(3,de), UBnd(3,de)
                    do i4=LBnd(4,de), UBnd(4,de)
                       do i5=LBnd(5,de), UBnd(5,de)
                       do i6=LBnd(6,de), UBnd(6,de)
                       farrayPtr6(i1,i2,i3,i4,i5,i6) = localDeToDeMap(de) +            &
                             1.0d5*i1 + 1.0d3*i2 + 1.0d1*i3 + 1.0d-1*i4        &
                             + 1.0d-3*i5 + 1.0d-5*i6
                       enddo   !   i6
                       enddo   !   i5
                    enddo   !   i4
                 enddo   !   i3
              enddo   !   i2
           enddo    !   i1
        enddo    ! de
     case(7)
     !--------------------------------------------------------------------------
     ! rank = 7
     !--------------------------------------------------------------------------
        do de=1, localDeCount
           call ESMF_LocalArrayGet(larrayList(de), farrayPtr=farrayPtr7, &
                                   datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)
           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                   "array list", rcToReturn=rc)) return

           do i1=LBnd(1,de), UBnd(1,de)
              do i2=LBnd(2,de), UBnd(2,de)
                 do i3=LBnd(3,de), UBnd(3,de)
                    do i4=LBnd(4,de), UBnd(4,de)
                       do i5=LBnd(5,de), UBnd(5,de)
                       do i6=LBnd(6,de), UBnd(6,de)
                       do i7=LBnd(7,de), UBnd(7,de)
                          farrayPtr7(i1,i2,i3,i4,i5,i6,i7) = localDeToDeMap(de) +      &
                             1.0d5*i1 + 1.0d3*i2 + 1.0d1*i3 + 1.0d-1*i4        &
                             + 1.0d-3*i5 + 1.0d-5*i6 + 1.0d0*i7
                       enddo   !   i7
                       enddo   !   i6
                       enddo   !   i5
                    enddo   !   i4
                 enddo   !   i3
              enddo   !   i2
           enddo    !   i1
        enddo    ! de
#endif
     case default
     !--------------------------------------------------------------------------
     ! error
     !--------------------------------------------------------------------------
        localrc = ESMF_FAILURE
        call ESMF_LogSetError(ESMF_FAILURE, msg="DimCount out of range", &
                 rcToReturn=localrc)
        return
     end select

  !-----------------------------------------------------------------------------
  ! Memory Rank > Grid Rank, then there are MemRank-GridRank tensor dimensions
  !-----------------------------------------------------------------------------
  elseif( Memory%memRank >  Memory%GridRank ) then
! -----------
      localrc = ESMF_FAILURE
      call ESMF_LogSetError(ESMF_FAILURE, msg="tensor dimensions not supported",      &
                    rcToReturn=localrc)
      return

  endif

  !-----------------------------------------------------------------------------
  ! clean up allocated arrays
  !-----------------------------------------------------------------------------
  deallocate(localDeToDeMap)
  deallocate(LBnd, UBnd)
  deallocate(larrayList)

  !-----------------------------------------------------------------------------
  rc = ESMF_SUCCESS
  !-----------------------------------------------------------------------------

  !-----------------------------------------------------------------------------
  end subroutine populate_redist_array
  !-----------------------------------------------------------------------------

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

  !-----------------------------------------------------------------------------
  subroutine populate_array_value(Array, value, DistGrid, Memory, Grid, rc)
  !-----------------------------------------------------------------------------
  ! routie populates an esmf array to a constant value. Typically used for
  ! initialization.
  !
  !-----------------------------------------------------------------------------
  ! arguments
  type(ESMF_Array), intent(inout) :: Array
  real(ESMF_KIND_R8), intent(in   ) :: value
  type(ESMF_DistGrid), intent(in   ) :: DistGrid
  type(memory_config), intent(in   ) :: Memory
  type(grid_specification_record), intent(in   ) :: Grid
  integer, intent(inout) :: rc

  ! local ESMF types
  type(ESMF_LocalArray), allocatable :: larrayList(:)
  type(ESMF_Index_Flag) :: indexflag

  ! local integer variables
  integer :: de, localDeCount, dimCount
  integer, allocatable ::  localDeToDeMap(:)
  integer, allocatable :: LBnd(:,:), UBnd(:,:)
  integer :: i1, i2, i3, i4, i5, i6, i7
  ! integer :: irank, k, tensorsize, fsize(7)
  ! integer, allocatable :: haloL(:), haloR(:)
  ! integer, allocatable :: top(:), bottom(:)
  integer :: localrc ! local error status
  integer :: allocRcToTest

  ! local real variables
  real(ESMF_KIND_R8), pointer :: farrayPtr1(:), farrayPtr2(:,:)
  real(ESMF_KIND_R8), pointer :: farrayPtr3(:,:,:)
  real(ESMF_KIND_R8), pointer :: farrayPtr4(:,:,:,:)
  real(ESMF_KIND_R8), pointer :: farrayPtr5(:,:,:,:,:)
  real(ESMF_KIND_R8), pointer :: farrayPtr6(:,:,:,:,:,:)
  real(ESMF_KIND_R8), pointer :: farrayPtr7(:,:,:,:,:,:,:)

  ! initialize return flag
  localrc = ESMF_RC_NOT_IMPL
  rc = ESMF_RC_NOT_IMPL

  !-----------------------------------------------------------------------------
  ! get local array DE list
  !-----------------------------------------------------------------------------
  call ESMF_ArrayGet(array, localDeCount=localDeCount, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting local DE count from array", &
          rcToReturn=rc)) return

  allocate(localDeToDeMap(localDeCount), stat=allocRcToTest )
  if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable"//           &
     " localDeToDeMap in populate_array_value", rcToReturn=rc)) then
  endif
  call ESMF_ArrayGet(array, localDeToDeMap=localDeToDeMap, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting local DE list from array",  &
          rcToReturn=rc)) return

  allocate(larrayList(localDeCount), stat=allocRcToTest )
  if (ESMF_LogFoundAllocError(allocRcToTest, msg="type "//                      &
     " larrayList in populate_array_value", rcToReturn=rc)) then
  endif
  call ESMF_ArrayGet(array, localarrayList=larrayList, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting local array list",          &
          rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! get dimcount to allocate bound arrays
  !-----------------------------------------------------------------------------
  call ESMF_DistGridGet(DistGrid, dimCount=dimCount, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting dimCount from distGrid",    &
          rcToReturn=rc)) return

  allocate(UBnd(dimCount, localDeCount), stat=allocRcToTest)
  if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable"//           &
     " UBnd in populate_array_value", rcToReturn=rc)) then
  endif
  allocate(LBnd(dimCount, localDeCount), stat=allocRcToTest)
  if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable"//           &
     " LBnd in populate_array_value", rcToReturn=rc)) then
  endif

  call ESMF_ArrayGet(array, indexflag=indexflag,                               &
           exclusiveLBound=LBnd, exclusiveUBound=UBnd, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting exclusive bound range",     &
          rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! associate the fortran pointer with the array object and populate the array
  !-----------------------------------------------------------------------------

  !-----------------------------------------------------------------------------
  ! Memory Rank = Grid Rank, then there are no tensor dimensions
  !-----------------------------------------------------------------------------
  if( Memory%memRank ==  Memory%GridRank ) then

     select case(dimCount)
     case(1)
     !--------------------------------------------------------------------------
     ! rank = 1
     !--------------------------------------------------------------------------
        do de=1, localDeCount
           call ESMF_LocalArrayGet(larrayList(de), farrayPtr=farrayPtr1, &
                                   datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)
           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                   "array list", rcToReturn=rc)) return

           do i1=LBnd(1,de), UBnd(1,de)
              farrayPtr1(i1) =  value
           enddo    !   i1
        enddo    ! de
     case(2)
     !--------------------------------------------------------------------------
     ! rank = 2
     !--------------------------------------------------------------------------
        do de=1, localDeCount
           call ESMF_LocalArrayGet(larrayList(de), farrayPtr=farrayPtr2, &
                                   datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)
           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                   "array list", rcToReturn=rc)) return

           do i1=LBnd(1,de), UBnd(1,de)
              do i2=LBnd(2,de), UBnd(2,de)
                 farrayPtr2(i1,i2) = value
              enddo   !   i2
           enddo    !   i1
        enddo    ! de
     case(3)
     !--------------------------------------------------------------------------
     ! rank = 3
     !--------------------------------------------------------------------------
        do de=1, localDeCount
           call ESMF_LocalArrayGet(larrayList(de), farrayPtr=farrayPtr3, &
                                   datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)
           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                   "array list", rcToReturn=rc)) return

           do i1=LBnd(1,de), UBnd(1,de)
              do i2=LBnd(2,de), UBnd(2,de)
                 do i3=LBnd(3,de), UBnd(3,de)
                    farrayPtr3(i1,i2,i3) = value
                 enddo   !   i3
              enddo   !   i2
           enddo    !   i1
        enddo    ! de
     case(4)
     !--------------------------------------------------------------------------
     ! rank = 4
     !--------------------------------------------------------------------------
        do de=1, localDeCount
           call ESMF_LocalArrayGet(larrayList(de), farrayPtr=farrayPtr4, &
                                   datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)
           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                   "array list", rcToReturn=rc)) return

           do i1=LBnd(1,de), UBnd(1,de)
              do i2=LBnd(2,de), UBnd(2,de)
                 do i3=LBnd(3,de), UBnd(3,de)
                    do i4=LBnd(4,de), UBnd(4,de)
                       farrayPtr4(i1,i2,i3,i4) = value
                    enddo   !   i4
                 enddo   !   i3
              enddo   !   i2
           enddo    !   i1
        enddo    ! de
#ifndef ESMF_NO_GREATER_THAN_4D
     case(5)
     !--------------------------------------------------------------------------
     ! rank = 5
     !--------------------------------------------------------------------------
        do de=1, localDeCount
           call ESMF_LocalArrayGet(larrayList(de), farrayPtr=farrayPtr5, &
                                   datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)
           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                   "array list", rcToReturn=rc)) return

           do i1=LBnd(1,de), UBnd(1,de)
              do i2=LBnd(2,de), UBnd(2,de)
                 do i3=LBnd(3,de), UBnd(3,de)
                    do i4=LBnd(4,de), UBnd(4,de)
                       do i5=LBnd(5,de), UBnd(5,de)
                          farrayPtr5(i1,i2,i3,i4,i5) =  value
                       enddo   !   i5
                    enddo   !   i4
                 enddo   !   i3
              enddo   !   i2
           enddo    !   i1
        enddo    ! de
     case(6)
     !--------------------------------------------------------------------------
     ! rank = 6
     !--------------------------------------------------------------------------
        do de=1, localDeCount
           call ESMF_LocalArrayGet(larrayList(de), farrayPtr=farrayPtr6, &
                                   datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)
           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                   "array list", rcToReturn=rc)) return

           do i1=LBnd(1,de), UBnd(1,de)
              do i2=LBnd(2,de), UBnd(2,de)
                 do i3=LBnd(3,de), UBnd(3,de)
                    do i4=LBnd(4,de), UBnd(4,de)
                       do i5=LBnd(5,de), UBnd(5,de)
                       do i6=LBnd(6,de), UBnd(6,de)
                       farrayPtr6(i1,i2,i3,i4,i5,i6) =  value
                       enddo   !   i6
                       enddo   !   i5
                    enddo   !   i4
                 enddo   !   i3
              enddo   !   i2
           enddo    !   i1
        enddo    ! de
     case(7)
     !--------------------------------------------------------------------------
     ! rank = 7
     !--------------------------------------------------------------------------
        do de=1, localDeCount
           call ESMF_LocalArrayGet(larrayList(de), farrayPtr=farrayPtr7, &
                                   datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)
           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                   "array list", rcToReturn=rc)) return

           do i1=LBnd(1,de), UBnd(1,de)
              do i2=LBnd(2,de), UBnd(2,de)
                 do i3=LBnd(3,de), UBnd(3,de)
                    do i4=LBnd(4,de), UBnd(4,de)
                       do i5=LBnd(5,de), UBnd(5,de)
                       do i6=LBnd(6,de), UBnd(6,de)
                       do i7=LBnd(7,de), UBnd(7,de)
                          farrayPtr7(i1,i2,i3,i4,i5,i6,i7) = value
                       enddo   !   i7
                       enddo   !   i6
                       enddo   !   i5
                    enddo   !   i4
                 enddo   !   i3
              enddo   !   i2
           enddo    !   i1
        enddo    ! de
#endif
     case default
     !--------------------------------------------------------------------------
     ! error
     !--------------------------------------------------------------------------
        localrc = ESMF_FAILURE
        call ESMF_LogSetError(ESMF_FAILURE, msg="DimCount out of range", &
                 rcToReturn=localrc)
        return
     end select

  !-----------------------------------------------------------------------------
  ! Memory Rank > Grid Rank, then there are MemRank-GridRank tensor dimensions
  !-----------------------------------------------------------------------------
  elseif( Memory%memRank >  Memory%GridRank ) then
! -----------
  endif

  !-----------------------------------------------------------------------------
  ! clean up allocated arrays
  !-----------------------------------------------------------------------------
  deallocate(localDeToDeMap)
  deallocate(LBnd, UBnd)
  deallocate(larrayList)

  !-----------------------------------------------------------------------------
  rc = ESMF_SUCCESS
  !-----------------------------------------------------------------------------

  !-----------------------------------------------------------------------------
  end subroutine populate_array_value
  !-----------------------------------------------------------------------------

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

  !-----------------------------------------------------------------------------
  subroutine compare_redist_array(test_status, Array1, Array2,                 &
                                  DistGrid1, DistGrid2,                        &
                                  Memory, Grid, rc)
  !-----------------------------------------------------------------------------
  ! routine compares the contents of two arrays and returns if they agree
  !-----------------------------------------------------------------------------
  ! arguments
  integer, intent(inout) :: test_status
  type(ESMF_Array), intent(in   ) :: Array1, Array2
  type(ESMF_DistGrid), intent(in   ) :: DistGrid1, DistGrid2
  type(memory_config), intent(in   ) :: Memory
  type(grid_specification_record), intent(in   ) :: Grid
  integer, intent(inout) :: rc

  ! local ESMF types
  type(ESMF_LocalArray), allocatable :: larrayList1(:)
  type(ESMF_LocalArray), allocatable :: larrayList2(:)
  type(ESMF_Index_Flag) :: indexflag

  ! local integer variables
  integer :: de, i1, i2, i3, i4, i5, i6, i7, k
  integer :: localDeCount1, dimCount1, localDeCount2, dimCount2
  integer, allocatable ::  localDeToDeMap1(:), localDeToDeMap2(:)
  integer, allocatable :: LBnd(:,:), UBnd(:,:)
  integer, allocatable :: LBnd2(:,:), UBnd2(:,:)
  ! integer :: irank, tensorsize, fsize(7)
  ! integer, allocatable :: haloL(:), haloR(:)
  ! integer, allocatable :: top(:), bottom(:)
  integer :: allocRcToTest
  integer :: localrc ! local error status

  ! local logicals
  ! logical :: nohaloflag

  ! local real variables
  real(ESMF_KIND_R8), pointer :: farray1D(:), farray2D(:,:)
  real(ESMF_KIND_R8), pointer :: farray3D(:,:,:)
  real(ESMF_KIND_R8), pointer :: farray4D(:,:,:,:)
  real(ESMF_KIND_R8), pointer :: farray5D(:,:,:,:,:)
  real(ESMF_KIND_R8), pointer :: farray6D(:,:,:,:,:,:)
  real(ESMF_KIND_R8), pointer :: farray7D(:,:,:,:,:,:,:)

  real(ESMF_KIND_R8), pointer :: rarray1D(:), rarray2D(:,:)
  real(ESMF_KIND_R8), pointer :: rarray3D(:,:,:)
  real(ESMF_KIND_R8), pointer :: rarray4D(:,:,:,:)
  real(ESMF_KIND_R8), pointer :: rarray5D(:,:,:,:,:)
  real(ESMF_KIND_R8), pointer :: rarray6D(:,:,:,:,:,:)
  real(ESMF_KIND_R8), pointer :: rarray7D(:,:,:,:,:,:,:)


  ! initialize return flag
  localrc = ESMF_RC_NOT_IMPL
  rc = ESMF_RC_NOT_IMPL
  test_status = HarnessTest_SUCCESS

  !-----------------------------------------------------------------------------
  ! Sanity check - confirm that the two arrays have the same ranks and sizes
  !-----------------------------------------------------------------------------

  !-----------------------------------------------------------------------------
  ! get local array DE list from array1
  !-----------------------------------------------------------------------------
  call ESMF_ArrayGet(array1, localDeCount=localDeCount1, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting local DE count from array", &
          rcToReturn=rc)) return

  allocate(localDeToDeMap1(localDeCount1), stat=allocRcToTest )
  if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable"//           &
     " localDeToDeMap1 in compare redist array", rcToReturn=rc)) then
  endif
  call ESMF_ArrayGet(array1, localDeToDeMap=localDeToDeMap1, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting local DE list from array",  &
          rcToReturn=rc)) return

  allocate(larrayList1(localDeCount1), stat=allocRcToTest )
  if (ESMF_LogFoundAllocError(allocRcToTest, msg="char variable"//              &
     " larrayList1 in compare redist array", rcToReturn=rc)) then
  endif
  call ESMF_ArrayGet(array1, localarrayList=larrayList1, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting local array list",          &
          rcToReturn=rc)) return

  call ESMF_DistGridGet(DistGrid1, dimCount=dimCount1, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting dimCount from distGrid",    &
          rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! get local array DE list from array2
  !-----------------------------------------------------------------------------
  call ESMF_ArrayGet(array2, localDeCount=localDeCount2, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting local DE count from array", &
          rcToReturn=rc)) return

  ! check localDeCount for agreement
  if( localDeCount1 /= localDeCount2 ) then
     localrc = ESMF_FAILURE
     call ESMF_LogSetError(ESMF_FAILURE, msg="local De Counts do not agree",     &
              rcToReturn=localrc)
     return
  endif

  allocate(localDeToDeMap2(localDeCount2), stat=allocRcToTest )
  if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable"//           &
     " localDeToDeMap2 in compare redist array", rcToReturn=rc)) then
  endif
  call ESMF_ArrayGet(array2, localDeToDeMap=localDeToDeMap2, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting local DE list from array",  &
          rcToReturn=rc)) return

  ! check localDeToDeMap for agreement
  do de=1, localDeCount2
     if( localDeToDeMap2(de) /= localDeToDeMap1(de) ) then
        localrc = ESMF_FAILURE
        call ESMF_LogSetError(ESMF_FAILURE, msg="local De lists do not agree",   &
                 rcToReturn=localrc)
        return
     endif
  enddo

  ! get local De List
  allocate(larrayList2(localDeCount2), stat=allocRcToTest )
  if (ESMF_LogFoundAllocError(allocRcToTest, msg="char variable"//              &
     " larrayList2 in compare redist array", rcToReturn=rc)) then
  endif
  call ESMF_ArrayGet(array2, localarrayList=larrayList2, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting local array list",          &
          rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! compare dimcounts for both arrays
  !-----------------------------------------------------------------------------
  call ESMF_DistGridGet(DistGrid2, dimCount=dimCount2, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting dimCount from distGrid",    &
          rcToReturn=rc)) return

  ! check localDeCount for agreement
  if( dimCount1 /= dimCount2 ) then
     localrc = ESMF_FAILURE
     call ESMF_LogSetError(ESMF_FAILURE, msg="array 1 and 2 dimCounts disagree", &
              rcToReturn=localrc)
     return
  endif

  !-----------------------------------------------------------------------------
  ! allocate bound arrays and extract exclusive bounds
  !-----------------------------------------------------------------------------
  allocate(UBnd(dimCount1, localDeCount1), stat=allocRcToTest )
  if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable"//           &
     " UBnd in compare redist array", rcToReturn=rc)) then
  endif
  allocate(LBnd(dimCount1, localDeCount1), stat=allocRcToTest )
  if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable"//           &
     " LBnd in compare redist array", rcToReturn=rc)) then
  endif

  call ESMF_ArrayGet(array=array1, indexflag=indexflag,                        &
           exclusiveLBound=LBnd, exclusiveUBound=UBnd, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting exclusive bound range",     &
          rcToReturn=rc)) return


  allocate(UBnd2(dimCount2, localDeCount2), stat=allocRcToTest )
  if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable"//           &
     " UBnd2 in compare redist array", rcToReturn=rc)) then
  endif
  allocate(LBnd2(dimCount2, localDeCount2), stat=allocRcToTest )
  if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable"//           &
     " LBnd2 in compare redist array", rcToReturn=rc)) then
  endif

  call ESMF_ArrayGet(array=array2, indexflag=indexflag,                        &
           exclusiveLBound=LBnd2, exclusiveUBound=UBnd2, rc=localrc)
  if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting exclusive bound range",     &
          rcToReturn=rc)) return

  !-----------------------------------------------------------------------------
  ! check for exclusive bound agreement
  !-----------------------------------------------------------------------------
  do de=1, localDeCount1
     do k=1,dimCount1
        if( LBnd(k,de) /= LBnd2(k,de) ) then
           print*,'exclusive Lower bounds disagree',LBnd(k,de),LBnd2(k,de)
           localrc = ESMF_FAILURE
           call ESMF_LogSetError(ESMF_FAILURE,msg="exclusive L bounds disagree",&
              rcToReturn=localrc)
           return
        endif
        if( UBnd(k,de) /= UBnd2(k,de) ) then
           print*,'exclusive Upper bounds disagree',UBnd(k,de),UBnd2(k,de)
           localrc = ESMF_FAILURE
           call ESMF_LogSetError(ESMF_FAILURE,msg="exclusive U bounds disagree",&
              rcToReturn=localrc)
           return
        endif
     enddo
  enddo
  !-----------------------------------------------------------------------------
  ! associate fortran pointers with the two local array objects and compare
  ! entries
  !-----------------------------------------------------------------------------

  !-----------------------------------------------------------------------------
  ! Memory Rank = Grid Rank, then there are no tensor dimensions
  !-----------------------------------------------------------------------------
  if( Memory%memRank ==  Memory%GridRank ) then

     select case(dimCount1)
     case(1)
     !--------------------------------------------------------------------------
     ! rank = 1
     !--------------------------------------------------------------------------
        do de=1, localDeCount1
           call ESMF_LocalArrayGet(larrayList1(de), farrayPtr=farray1D,             &
                    datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)

           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                  "array1 list", rcToReturn=rc)) return

           call ESMF_LocalArrayGet(larrayList2(de), farrayPtr=rarray1D,             &
                    datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)

           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                   "array2 list", rcToReturn=rc)) return

           do i1=LBnd(1,de), UBnd(1,de)
              if( farray1D(i1) /= rarray1D(i1) ) then
                 test_status = HarnessTest_FAILURE
                 print*,' arrays disagree ',i1,farray1D(i1),                   &
                        rarray1D(i1)
              endif
           enddo    !   i1
        enddo    ! de
     case(2)
     !--------------------------------------------------------------------------
     ! rank = 2
     !--------------------------------------------------------------------------
        do de=1, localDeCount1
           call ESMF_LocalArrayGet(larrayList1(de), farrayPtr=farray2D,             &
                    datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)

           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                  "array1 list", rcToReturn=rc)) return

           call ESMF_LocalArrayGet(larrayList2(de), farrayPtr=rarray2D,             &
                    datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)

           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                   "array2 list", rcToReturn=rc)) return

           do i1=LBnd(1,de), UBnd(1,de)
             do i2=LBnd(2,de), UBnd(2,de)
               if( farray2D(i1,i2) /= rarray2D(i1,i2) ) then
                 test_status = HarnessTest_FAILURE
                 print*,' arrays disagree ',i1,i2,farray2D(i1,i2),             &
                        rarray2D(i1,i2)
               endif
             enddo   !   i2
           enddo    !   i1
        enddo    ! de
     case(3)
     !--------------------------------------------------------------------------
     ! rank = 3
     !--------------------------------------------------------------------------
        do de=1, localDeCount1
           call ESMF_LocalArrayGet(larrayList1(de), farrayPtr=farray3D,             &
                    datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)

           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                  "array1 list", rcToReturn=rc)) return

           call ESMF_LocalArrayGet(larrayList2(de), farrayPtr=rarray3D,             &
                    datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)

           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                   "array2 list", rcToReturn=rc)) return

           do i1=LBnd(1,de), UBnd(1,de)
             do i2=LBnd(2,de), UBnd(2,de)
                do i3=LBnd(3,de), UBnd(3,de)
                   if( farray3D(i1,i2,i3) /= rarray3D(i1,i2,i3) ) then
                       test_status = HarnessTest_FAILURE
                       print*,' arrays disagree ',i1,i2,i3,farray3D(i1,i2,i3), &
                              rarray3D(i1,i2,i3)
                   endif
                enddo   !   i3
             enddo   !   i2
           enddo    !   i1
        enddo    ! de
     case(4)
     !--------------------------------------------------------------------------
     ! rank = 4
     !--------------------------------------------------------------------------
        do de=1, localDeCount1
           call ESMF_LocalArrayGet(larrayList1(de), farrayPtr=farray4D,             &
                    datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)

           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                  "array1 list", rcToReturn=rc)) return

           call ESMF_LocalArrayGet(larrayList2(de), farrayPtr=rarray4D,             &
                    datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)

           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                   "array2 list", rcToReturn=rc)) return

           do i1=LBnd(1,de), UBnd(1,de)
             do i2=LBnd(2,de), UBnd(2,de)
                do i3=LBnd(3,de), UBnd(3,de)
                   do i4=LBnd(4,de), UBnd(4,de)
                      if( farray4D(i1,i2,i3,i4) /= rarray4D(i1,i2,i3,i4) ) then
                       test_status = HarnessTest_FAILURE
                       print*,' arrays disagree ',i1,i2,i3,i4,                 &
                              farray4D(i1,i2,i3,i4), rarray4D(i1,i2,i3,i4)
                      endif
                   enddo   !   i4
                enddo   !   i3
             enddo   !   i2
           enddo    !   i1
        enddo    ! de
#ifndef ESMF_NO_GREATER_THAN_4D
     case(5)
     !--------------------------------------------------------------------------
     ! rank = 5
     !--------------------------------------------------------------------------
        do de=1, localDeCount1
           call ESMF_LocalArrayGet(larrayList1(de), farrayPtr=farray5D,             &
                    datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)

           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                  "array1 list", rcToReturn=rc)) return

           call ESMF_LocalArrayGet(larrayList2(de), farrayPtr=rarray5D,             &
                    datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)

           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                   "array2 list", rcToReturn=rc)) return

           do i1=LBnd(1,de), UBnd(1,de)
             do i2=LBnd(2,de), UBnd(2,de)
                do i3=LBnd(3,de), UBnd(3,de)
                   do i4=LBnd(4,de), UBnd(4,de)
                      do i5=LBnd(5,de), UBnd(5,de)
                         if( farray5D(i1,i2,i3,i4,i5) /=                       &
                             rarray5D(i1,i2,i3,i4,i5) ) then
                               test_status = HarnessTest_FAILURE
                               print*,' arrays disagree ',i1,i2,i3,i4,i5,      &
                              farray5D(i1,i2,i3,i4,i5),                        &
                              rarray5D(i1,i2,i3,i4,i5)
                         endif
                      enddo   !   i5
                   enddo   !   i4
                enddo   !   i3
             enddo   !   i2
           enddo    !   i1
        enddo    ! de
     case(6)
     !--------------------------------------------------------------------------
     ! rank = 6
     !--------------------------------------------------------------------------
        do de=1, localDeCount1
           call ESMF_LocalArrayGet(larrayList1(de), farrayPtr=farray6D,             &
                    datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)

           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                  "array1 list", rcToReturn=rc)) return

           call ESMF_LocalArrayGet(larrayList2(de), farrayPtr=rarray6D,             &
                    datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)

           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                   "array2 list", rcToReturn=rc)) return

           do i1=LBnd(1,de), UBnd(1,de)
             do i2=LBnd(2,de), UBnd(2,de)
                do i3=LBnd(3,de), UBnd(3,de)
                   do i4=LBnd(4,de), UBnd(4,de)
                      do i5=LBnd(5,de), UBnd(5,de)
                      do i6=LBnd(6,de), UBnd(6,de)
                         if( farray6D(i1,i2,i3,i4,i5,i6) /=                    &
                             rarray6D(i1,i2,i3,i4,i5,i6) ) then
                               test_status = HarnessTest_FAILURE
                               print*,' arrays disagree ',i1,i2,i3,i4,i5,i6,   &
                              farray6D(i1,i2,i3,i4,i5,i6),                     &
                              rarray6D(i1,i2,i3,i4,i5,i6)
                         endif
                      enddo   !   i6
                      enddo   !   i5
                   enddo   !   i4
                enddo   !   i3
             enddo   !   i2
           enddo    !   i1
        enddo    ! de
     case(7)
     !--------------------------------------------------------------------------
     ! rank = 7
     !--------------------------------------------------------------------------
        do de=1, localDeCount1
           call ESMF_LocalArrayGet(larrayList1(de), farrayPtr=farray7D,             &
                    datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)

           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                  "array1 list", rcToReturn=rc)) return

           call ESMF_LocalArrayGet(larrayList2(de), farrayPtr=rarray7D,             &
                    datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc)

           if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error connecting pointer to " // &
                   "array2 list", rcToReturn=rc)) return

           do i1=LBnd(1,de), UBnd(1,de)
             do i2=LBnd(2,de), UBnd(2,de)
                do i3=LBnd(3,de), UBnd(3,de)
                   do i4=LBnd(4,de), UBnd(4,de)
                      do i5=LBnd(5,de), UBnd(5,de)
                      do i6=LBnd(6,de), UBnd(6,de)
                      do i7=LBnd(7,de), UBnd(7,de)
                         if( farray7D(i1,i2,i3,i4,i5,i6,i7) /=                 &
                             rarray7D(i1,i2,i3,i4,i5,i6,i7) ) then
                              test_status = HarnessTest_FAILURE
                              print*,' arrays disagree ',i1,i2,i3,i4,i5,i6,i7, &
                              farray7D(i1,i2,i3,i4,i5,i6,i7),                  &
                              rarray7D(i1,i2,i3,i4,i5,i6,i7)
                         endif
                      enddo   !   i7
                      enddo   !   i6
                      enddo   !   i5
                   enddo   !   i4
                enddo   !   i3
             enddo   !   i2
           enddo    !   i1
        enddo    ! de
#endif
     case default
        ! error
        localrc = ESMF_FAILURE
        call ESMF_LogSetError(ESMF_FAILURE, msg="DimCount out of range",  &
                 rcToReturn=localrc)
        return
     end select

  !-----------------------------------------------------------------------------
  ! Memory Rank > Grid Rank, then there are MemRank-GridRank tensor dimensions
  !-----------------------------------------------------------------------------
  elseif (Memory%memRank >  Memory%GridRank) then
    call ESMF_LogSetError (ESMF_FAILURE, msg="tensor dimensions not supported", &
         rcToReturn=rc)
    return

  !-----------------------------------------------------------------------------
  ! Memory Rank < Grid Rank, then parameters don't make sense
  !-----------------------------------------------------------------------------
  else
    call ESMF_LogSetError (ESMF_FAILURE, msg="memory rank < grid rank", &
         rcToReturn=rc)
    return
  endif

  !-----------------------------------------------------------------------------
  ! clean up allocated arrays
  !-----------------------------------------------------------------------------
  deallocate(larrayList1, larrayList2)
  deallocate(localDeToDeMap1, localDeToDeMap2)
  deallocate(LBnd, UBnd)
  deallocate( LBnd2, UBnd2 )

  !-----------------------------------------------------------------------------
  rc = ESMF_SUCCESS
  !-----------------------------------------------------------------------------

  !-----------------------------------------------------------------------------
  end subroutine compare_redist_array
  !-----------------------------------------------------------------------------

  !-----------------------------------------------------------------------------
  real(ESMF_KIND_R8) function create_coord(index, grid, axis, rc)
  !-----------------------------------------------------------------------------
  ! selects coordinate value based upon specified grid type.
  !-----------------------------------------------------------------------------
  integer, intent(in   ) :: index, axis
  integer, intent(inout) :: rc
  type(grid_specification_record)::grid

  !-----------------------------------------------------------------------------
  !
  !-----------------------------------------------------------------------------
  select case( trim(grid%gtype(axis)%string) )
    case("UNI")
       create_coord = create_uniform_coord(index, grid%grange(axis,2),         &
                            grid%grange(axis,1), grid%gsize(axis))
    case("UNIFORM")
       create_coord = create_uniform_coord(index, grid%grange(axis,2),         &
                            grid%grange(axis,1), grid%gsize(axis))
    case("UNIFORM_POLE")
       create_coord = create_uniform_coord(index, grid%grange(axis,2),         &
                            grid%grange(axis,1), grid%gsize(axis))
    case("UNIFORM_PERIODIC")
       create_coord = create_uniform_coord(index, grid%grange(axis,2),         &
                            grid%grange(axis,1), grid%gsize(axis))
    case("GAUSS")
       create_coord = create_gaussian_coord(index, grid%grange(axis,2),        &
                            grid%grange(axis,1), grid%gsize(axis))
    case("GAUSSIAN")
       create_coord = create_gaussian_coord(index, grid%grange(axis,2),        &
                            grid%grange(axis,1), grid%gsize(axis))
    case("GAUSSIAN_POLE")
       create_coord = create_gaussian_coord(index, grid%grange(axis,2),        &
                            grid%grange(axis,1), grid%gsize(axis))
    case("GAUSSIAN_PERIODIC")
       create_coord = create_gaussian_coord(index, grid%grange(axis,2),        &
                            grid%grange(axis,1), grid%gsize(axis))
    case default
       print*,'Unsupported grid type',trim(grid%gtype(axis)%string)
       call ESMF_LogSetError( ESMF_FAILURE, msg="Unsupported grid type " //       &
               trim(grid%gtype(axis)%string), rcToReturn=rc)
       return

  end select

  !-----------------------------------------------------------------------------
  end function create_coord
  !-----------------------------------------------------------------------------

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

  !-----------------------------------------------------------------------------
  real(ESMF_KIND_R8) function create_uniform_coord(k, finish, start, ncells)
  !-----------------------------------------------------------------------------
  ! define the coordinate for a uniform grid in terms of the global index k,
  ! the top and bottom of the range (finish and start), and the total number
  ! of cells.
  ! create_uniform_coord(1) = start
  ! create_uniform_coord(ncells) = finish
  !-----------------------------------------------------------------------------
  integer :: k, ncells
  real(ESMF_KIND_R8) :: finish, start
  !-----------------------------------------------------------------------------
  create_uniform_coord =  (k-1)*(finish-start)/(ncells-1) +start

  !-----------------------------------------------------------------------------
  end function create_uniform_coord
  !-----------------------------------------------------------------------------

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

  !-----------------------------------------------------------------------------
  real(ESMF_KIND_R8) function create_gaussian_coord(k, finish, start, ncells)
  !-----------------------------------------------------------------------------
  ! define the coordinates for a gaussian grid in terms of the global index k,
  ! the top and bottom of the range (finish and start), and the total number
  ! of cells.
  ! create_uniform_coord(1) = start
  ! create_uniform_coord(ncells) = finish
  !-----------------------------------------------------------------------------
  integer :: k, ncells
  real(ESMF_KIND_R8) :: finish, start, coord
  real(ESMF_KIND_R8), allocatable :: root(:), w(:)

  ! allocate work space
  allocate( root(ncells), w(ncells) )

  !-----------------------------------------------------------------------------
  ! compute all the roots (we only are asking for one, but I can't figure out
  ! how to only compute the one we want).
  !-----------------------------------------------------------------------------
  call legendre_roots(ncells,root,w)

  !-----------------------------------------------------------------------------
  ! pih - root(ncells+1-k) constructs gaussian grid on the interval -pi to pi
  ! shift to 0:2*(root(ncells)-pih)
  !-----------------------------------------------------------------------------
  coord =  root(ncells) - root(ncells+1-k)

  ! adjust range from start to finish
  create_gaussian_coord = coord * 0.5*(finish - start)/(root(ncells)-pih) + start

  !-----------------------------------------------------------------------------
  ! clean up
  !-----------------------------------------------------------------------------
  deallocate( root, w )

  !-----------------------------------------------------------------------------
  end function create_gaussian_coord
  !-----------------------------------------------------------------------------

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

  !-----------------------------------------------------------------------------
      subroutine legendre_roots(l,root,w)
  !-----------------------------------------------------------------------------
  ! Subroutine finds the l roots (in theta) and gaussian weights associated
  ! with the legendre polynomial of degree l > 1. (Source from SCRIP create
  ! gaussian grid routine
  !-----------------------------------------------------------------------------
  implicit none

  !-----------------------------------------------------------------------------
  !   arguments
  !-----------------------------------------------------------------------------
  integer, intent(in) :: l

  real(ESMF_KIND_R8), dimension(l), intent(out) :: root, w

  !-----------------------------------------------------------------------------
  !   local variables
  !-----------------------------------------------------------------------------
  integer :: l1, l2, l22, l3, k, i, j
  real(ESMF_KIND_R8) :: del,co,p1,p2,p3,t1,t2,slope,s,c,pp1,pp2,p00

  !-----------------------------------------------------------------------------
  !   Define useful constants.
  !-----------------------------------------------------------------------------
  del= pi/float(4*l)
  l1 = l+1
  co = float(2*l+3)/float(l1**2)
  p2 = 1.0
  t2 = -del
  l2 = l/2
  k = 1
  p00 = one/sqrt(two)

  !-----------------------------------------------------------------------------
  !   Start search for each root by looking for crossing point.
  !-----------------------------------------------------------------------------
  do i=1,l2
 10  t1 = t2
     t2 = t1+del
     p1 = p2
     s = sin(t2)
     c = cos(t2)
     pp1 = 1.0
     p3 = p00
     do j=1,l1
        pp2 = pp1
        pp1 = p3
        p3 = 2.0*sqrt((float(j**2)-0.250)/float(j**2))*c*pp1-                  &
             sqrt(float((2*j+1)*(j-1)*(j-1))/float((2*j-3)*j*j))*pp2
     enddo
     p2 = pp1
     if ((k*p2).gt.0) goto 10

  !-----------------------------------------------------------------------------
  !      Now converge using Newton-Raphson.
  !-----------------------------------------------------------------------------
     k = -k
 20  continue
     slope = (t2-t1)/(p2-p1)
     t1 = t2
     t2 = t2-slope*p2
     p1 = p2
     s = sin(t2)
     c = cos(t2)
     pp1 = 1.0
     p3 = p00
     do j=1,l1
        pp2 = pp1
        pp1 = p3
        p3 = 2.0*sqrt((float(j**2)-0.250)/float(j**2))*c*pp1-                  &
             sqrt(float((2*j+1)*(j-1)*(j-1))/float((2*j-3)*j*j))*pp2
     enddo
     p2 = pp1
     if (abs(p2).gt.1.e-10) goto 20
     root(i) = t2
     w(i) = co*(sin(t2)/p3)**2
  enddo

  !-----------------------------------------------------------------------------
  !   If l is odd, take care of odd point.
  !-----------------------------------------------------------------------------
  l22 = 2*l2
  if (l22 .ne. l) then
     l2 = l2+1
     t2 = pi/2.0
     root(l2) = t2
     s = sin(t2)
     c = cos(t2)
     pp1 = 1.0
     p3 = p00
     do j=1,l1
        pp2 = pp1
        pp1 = p3
        p3 = 2.0*sqrt((float(j**2)-0.250)/float(j**2))*c*pp1-                  &
             sqrt(float((2*j+1)*(j-1)*(j-1))/float((2*j-3)*j*j))*pp2
     enddo
     p2 = pp1
     w(l2) = co/p3**2
  endif

  !-----------------------------------------------------------------------------
  !   Use symmetry to compute remaining roots and weights.
  !-----------------------------------------------------------------------------
  l3 = l2+1
  do i=l3,l
     root(i) = pi-root(l-i+1)
     w(i) = w(l-i+1)
  enddo

  return

  !-----------------------------------------------------------------------------
      end subroutine legendre_roots
  !-----------------------------------------------------------------------------

!===============================================================================
  end module ESMF_TestHarnessMod
!===============================================================================

