ESMF_InterArrayCreatePtr Function

  recursive function ESMF_InterArrayCreatePtr(farray1D, farray2D, farray3D, &
       farray1DI8, farray2DI8, farray3DI8, &
       farray1DR8, farray2DR8, farray3DR8, &
       transferOwnership, rc) &
       result (InterArrayCreatePtr)
!
! !ARGUMENTS:
    integer, pointer,                   optional :: farray1D(:)
    integer, pointer,                   optional :: farray2D(:,:)
    integer, pointer,                   optional :: farray3D(:,:,:)
    integer(ESMF_KIND_I8), pointer,     optional :: farray1DI8(:)
    integer(ESMF_KIND_I8), pointer,     optional :: farray2DI8(:,:)
    integer(ESMF_KIND_I8), pointer,     optional :: farray3DI8(:,:,:)
    real(ESMF_KIND_R8), pointer,        optional :: farray1DR8(:)
    real(ESMF_KIND_R8), pointer,        optional :: farray2DR8(:,:)
    real(ESMF_KIND_R8), pointer,        optional :: farray3DR8(:,:,:)
    logical,               intent(in)            :: transferOwnership
    integer,               intent(out), optional :: rc
!
! !RETURN VALUE:
    type(ESMF_InterArray) :: InterArrayCreatePtr
!
! !DESCRIPTION:
!   Create an {\tt ESMF\_InterArray} from Fortran array. The
!   {\tt transferOwnership} allows ownership of the Fortran array to be
!   transferred to the InterArray object. InterArrayDestroy() will call
!   deallocate() for Fortran arrays whose ownership was transferred.
!
!   The arguments are:
!   \begin{description}
!   \item[{[farray1D]}]
!     1D Fortran array of default integer kind.
!   \item[{[farray2D]}]
!     2D Fortran array of default integer kind.
!   \item[{[farray3D]}]
!     3D Fortran array of default integer kind.
!   \item[{[farray1DI8]}]
!     1D Fortran array of ESMF_TYPEKIND_I8.
!   \item[{[farray2DI8]}]
!     2D Fortran array of ESMF_TYPEKIND_I8.
!   \item[{[farray3DI8]}]
!     3D Fortran array of ESMF_TYPEKIND_I8.
!   \item[{[farray1DR8]}]
!     1D Fortran array of ESMF_TYPEKIND_R8.
!   \item[{[farray2DR8]}]
!     2D Fortran array of ESMF_TYPEKIND_R8.
!   \item[{[farray3DR8]}]
!     3D Fortran array of ESMF_TYPEKIND_R8.
!   \item[transferOwnership]
!     For a value of {\tt .true.} transfers ownership of Fortran array to the
!     newly created InterArray object.
!   \item[{[rc]}]
!     Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
!   \end{description}
!
!EOPI
!------------------------------------------------------------------------------
    integer                 :: localrc      ! local return code
    type(ESMF_InterArray)   :: array        ! opaque pointer to new C++ object
    integer, allocatable    :: len(:)
    integer                 :: checkCount
    integer(ESMF_KIND_I8)   :: dummyI8
    real(ESMF_KIND_R8)      :: dummyR8

    ! initialize return code; assume routine not implemented
    localrc = ESMF_RC_NOT_IMPL
    if (present(rc)) rc = ESMF_RC_NOT_IMPL

    ! mark this InterArray as invalid
    call c_ESMC_InterArraySetInvalid(array, localrc)
    InterArrayCreatePtr = array
    if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return

    ! initialize Fortran array references
    nullify(array%farray1D)
    nullify(array%farray2D)
    nullify(array%farray3D)
    nullify(array%farray1DI8)
    nullify(array%farray2DI8)
    nullify(array%farray3DI8)
    nullify(array%farray1DR8)
    nullify(array%farray2DR8)
    nullify(array%farray3DR8)

    ! check that only one of the array arguments is present
    checkCount = 0  ! reset
    if (present(farray1D)) then
      if (associated(farray1D)) checkCount = checkCount + 1
    endif
    if (present(farray2D)) then
      if (associated(farray2D)) checkCount = checkCount + 1
    endif
    if (present(farray3D)) then
      if (associated(farray3D)) checkCount = checkCount + 1
    endif
    if (present(farray1DI8)) then
      if (associated(farray1DI8)) checkCount = checkCount + 1
    endif
    if (present(farray2DI8)) then
      if (associated(farray2DI8)) checkCount = checkCount + 1
    endif
    if (present(farray3DI8)) then
      if (associated(farray3DI8)) checkCount = checkCount + 1
    endif
    if (present(farray1DR8)) then
      if (associated(farray1DR8)) checkCount = checkCount + 1
    endif
    if (present(farray2DR8)) then
      if (associated(farray2DR8)) checkCount = checkCount + 1
    endif
    if (present(farray3DR8)) then
      if (associated(farray3DR8)) checkCount = checkCount + 1
    endif
    if (checkCount>1) then
      call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
        msg="too many farrayXD arguments were specified.", &
        ESMF_CONTEXT, rcToReturn=rc)
      return
    endif

    ! set owner flag
    array%owner = transferOwnership

    ! call into the C++ interface, depending on whether or not farray is present
    if (present(farray1D)) then
      if (associated(farray1D)) then
        array%farray1D => farray1D
        allocate(len(1))
        len = shape(farray1D)
        if (all(len .ne. 0)) then
          call c_ESMC_InterArrayCreate1D(array, farray1D(1), len, localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        else
          call c_ESMC_InterArrayCreate1D(array, 0, len, localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        endif
        deallocate(len)
      endif
    endif
    if (present(farray2D)) then
      if (associated(farray2D)) then
        array%farray2D => farray2D
        allocate(len(2))
        len = shape(farray2D)
        if (all(len .ne. 0)) then
          call c_ESMC_InterArrayCreate2D(array, farray2D(1,1), len, localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        else
          call c_ESMC_InterArrayCreate2D(array, 0, len, localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        endif
        deallocate(len)
      endif
    endif
    if (present(farray3D)) then
      if (associated(farray3D)) then
        array%farray3D => farray3D
        allocate(len(3))
        len = shape(farray3D)
        if (all(len .ne. 0)) then
          call c_ESMC_InterArrayCreate3D(array, farray3D(1,1,1), len, localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        else
          call c_ESMC_InterArrayCreate3D(array, 0, len, localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        endif
        deallocate(len)
      endif
    endif
    if (present(farray1DI8)) then
      if (associated(farray1DI8)) then
        array%farray1DI8 => farray1DI8
        allocate(len(1))
        len = shape(farray1DI8)
        if (all(len .ne. 0)) then
          call c_ESMC_InterArrayCreate1DI8(array, farray1DI8(1), len, localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        else
          call c_ESMC_InterArrayCreate1DI8(array, dummyI8, len, localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        endif
        deallocate(len)
      endif
    endif
    if (present(farray2DI8)) then
      if (associated(farray2DI8)) then
        array%farray2DI8 => farray2DI8
        allocate(len(2))
        len = shape(farray2DI8)
        if (all(len .ne. 0)) then
          call c_ESMC_InterArrayCreate2DI8(array, farray2DI8(1,1), len, &
            localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        else
          call c_ESMC_InterArrayCreate2DI8(array, dummyI8, len, localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        endif
        deallocate(len)
      endif
    endif
    if (present(farray3DI8)) then
      if (associated(farray3DI8)) then
        array%farray3DI8 => farray3DI8
        allocate(len(3))
        len = shape(farray3DI8)
        if (all(len .ne. 0)) then
          call c_ESMC_InterArrayCreate3DI8(array, farray3DI8(1,1,1), len, &
            localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        else
          call c_ESMC_InterArrayCreate3DI8(array, dummyI8, len, localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        endif
        deallocate(len)
      endif
    endif

    if (present(farray1DR8)) then
      if (associated(farray1DR8)) then
        array%farray1DR8 => farray1DR8
        allocate(len(1))
        len = shape(farray1DR8)
        if (all(len .ne. 0)) then
          call c_ESMC_InterArrayCreate1DR8(array, farray1DR8(1), len, localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        else
          call c_ESMC_InterArrayCreate1DR8(array, dummyR8, len, localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        endif
        deallocate(len)
      endif
    endif
    if (present(farray2DR8)) then
      if (associated(farray2DR8)) then
        array%farray2DR8 => farray2DR8
        allocate(len(2))
        len = shape(farray2DR8)
        if (all(len .ne. 0)) then
          call c_ESMC_InterArrayCreate2DR8(array, farray2DR8(1,1), len, &
            localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        else
          call c_ESMC_InterArrayCreate2DR8(array, dummyR8, len, localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        endif
        deallocate(len)
      endif
    endif
    if (present(farray3DR8)) then
      if (associated(farray3DR8)) then
        array%farray3DR8 => farray3DR8
        allocate(len(3))
        len = shape(farray3DR8)
        if (all(len .ne. 0)) then
          call c_ESMC_InterArrayCreate3DR8(array, farray3DR8(1,1,1), len, &
            localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        else
          call c_ESMC_InterArrayCreate3DR8(array, dummyR8, len, localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
            ESMF_CONTEXT, rcToReturn=rc)) return
        endif
        deallocate(len)
      endif
    endif

    ! set return value
    InterArrayCreatePtr = array

    ! return successfully
    if (present(rc)) rc = ESMF_SUCCESS

  end function ESMF_InterArrayCreatePtr