! $Id: ESMF_ArrayGet.cppF90,v 1.71 2011/06/30 21:30:51 theurich Exp $ ! ! Earth System Modeling Framework ! Copyright 2002-2011, 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_ArrayGet.F90" !============================================================================== #if 0 !============================================================================== ! TKR overloading macros #endif #include "ESMF_TypeKindRankMacros.hcppF90" !============================================================================== ! ESMF ArrayGet module module ESMF_ArrayGetMod ! !============================================================================== ! ! This file contains the ArrayGet() methods. ! !------------------------------------------------------------------------------ ! INCLUDES ^include "ESMF.h" !------------------------------------------------------------------------------ !BOPI ! !MODULE: ESMF_ArrayGetMod - Provide TKR overloading for ESMF_ArrayGet() ! ! !DESCRIPTION: ! ! The code in this file is part of the {\tt ESMF\_Array} class Fortran API. ! ! !------------------------------------------------------------------------------ ! !USES: use ESMF_UtilTypesMod ! ESMF utility types use ESMF_InitMacrosMod ! ESMF initializer macros use ESMF_BaseMod ! ESMF base class use ESMF_LogErrMod ! ESMF error handling use ESMF_LocalArrayMod use ESMF_ArraySpecMod use ESMF_VMMod use ESMF_DELayoutMod use ESMF_DistGridMod use ESMF_RHandleMod use ESMF_F90InterfaceMod ! ESMF Fortran-C++ interface helper ! class sub modules use ESMF_ArrayCreateMod ! contains the ESMF_Array derived type definition implicit none private !------------------------------------------------------------------------------ ! ! !PUBLIC MEMBER FUNCTIONS: ! - ESMF-public methods: public ESMF_ArrayGet ! - ESMF-internal methods: public ESMF_ArrayConstructPioDof !EOPI !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ ! The following line turns the CVS identifier string into a printable variable. character(*), parameter, private :: version = & '$Id: ESMF_ArrayGet.cppF90,v 1.71 2011/06/30 21:30:51 theurich Exp $' !============================================================================== ! ! INTERFACE BLOCKS ! !============================================================================== ! -------------------------- ESMF-public method ------------------------------- !BOPI ! !IROUTINE: ESMF_ArrayGet -- Generic interface ! !INTERFACE: interface ESMF_ArrayGet ! !PRIVATE MEMBER FUNCTIONS: ! module procedure ESMF_ArrayGetDefault module procedure ESMF_ArrayGetPLocalDePDim TypeKindRankInterfaceMacro(ArrayGetFPtr) module procedure ESMF_ArrayGetLocalArray module procedure ESMF_ArrayGetTotalElementMask1D module procedure ESMF_ArrayGetTotalElementMask2D module procedure ESMF_ArrayGetTotalElementMask3D module procedure ESMF_ArrayGetHalo ! !DESCRIPTION: ! This interface provides a single entry point for the various ! types of {\tt ESMF\_ArrayGet} functions. !EOPI end interface !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !=============================================================================== ! ArrayGet() interfaces !=============================================================================== ! -------------------------- ESMF-public method ------------------------------- ^undef ESMF_METHOD ^define ESMF_METHOD "ESMF_ArrayGetDefault()" !BOP ! !IROUTINE: ESMF_ArrayGet - Access to Array internals ! !INTERFACE: ! Private name; call using ESMF_ArrayGet() subroutine ESMF_ArrayGetDefault(array, keywordEnforcer, arrayspec, typekind, & rank, localarrayList, indexflag, distgridToArrayMap, & distgridToPackedArrayMap, arrayToDistGridMap, undistLBound, & undistUBound, exclusiveLBound, exclusiveUBound, computationalLBound, & computationalUBound, totalLBound, totalUBound, computationalLWidth, & computationalUWidth, totalLWidth, totalUWidth, distgrid, dimCount, & tileCount, minIndexPTile, maxIndexPTile, deToTileMap, indexCountPDe, & delayout, deCount, localDeCount, localDeList, name, rc) ! ! !ARGUMENTS: type(ESMF_Array), intent(in) :: array type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below type(ESMF_ArraySpec), intent(out), optional :: arrayspec type(ESMF_TypeKind_Flag), intent(out), optional :: typekind integer, intent(out), optional :: rank type(ESMF_LocalArray), target, intent(out), optional :: localarrayList(:) type(ESMF_Index_Flag), intent(out), optional :: indexflag integer, target, intent(out), optional :: distgridToArrayMap(:) integer, target, intent(out), optional :: distgridToPackedArrayMap(:) integer, target, intent(out), optional :: arrayToDistGridMap(:) integer, target, intent(out), optional :: undistLBound(:) integer, target, intent(out), optional :: undistUBound(:) integer, target, intent(out), optional :: exclusiveLBound(:,:) integer, target, intent(out), optional :: exclusiveUBound(:,:) integer, target, intent(out), optional :: computationalLBound(:,:) integer, target, intent(out), optional :: computationalUBound(:,:) integer, target, intent(out), optional :: totalLBound(:,:) integer, target, intent(out), optional :: totalUBound(:,:) integer, target, intent(out), optional :: computationalLWidth(:,:) integer, target, intent(out), optional :: computationalUWidth(:,:) integer, target, intent(out), optional :: totalLWidth(:,:) integer, target, intent(out), optional :: totalUWidth(:,:) type(ESMF_DistGrid), intent(out), optional :: distgrid integer, intent(out), optional :: dimCount integer, intent(out), optional :: tileCount integer, intent(out), optional :: minIndexPTile(:,:) integer, intent(out), optional :: maxIndexPTile(:,:) integer, intent(out), optional :: deToTileMap(:) integer, intent(out), optional :: indexCountPDe(:,:) type(ESMF_DELayout), intent(out), optional :: delayout integer, intent(out), optional :: deCount integer, intent(out), optional :: localDeCount integer, intent(out), optional :: localDeList(:) character(len=*), intent(out), optional :: name integer, intent(out), optional :: rc ! ! !STATUS: ! \apiStatusCompatible ! ! !DESCRIPTION: ! Get internal information. ! ! This interface works for any number of DEs per PET. ! ! The arguments are: ! \begin{description} ! \item[array] ! Queried {\tt ESMF\_Array} object. ! \item[{[arrayspec]}] ! {\tt ESMF\_ArraySpec} object containing the type/kind/rank information ! of the Array object. ! \item[{[typekind]}] ! TypeKind of the Array object. ! \item[{[rank]}] ! Rank of the Array object. ! \item[{[localarrayList]}] ! Upon return this holds a list of the associated {\tt ESMC\_LocalArray} ! objects. {\tt localarrayList} must be allocated to be of size ! {\tt localDeCount}, i.e. the number of DEs associated with the calling ! PET. ! \item[{[indexflag]}] ! Upon return this flag indicates how the DE-local indices are defined. ! See section \ref{const:indexflag} for a list of possible return values. ! \item[{[distgridToArrayMap]}] ! Upon return this list holds the Array dimensions against which the ! DistGrid dimensions are mapped. {\tt distgridToArrayMap} must be allocated ! to be of size {\tt dimCount}. An entry of zero indicates that the ! respective DistGrid dimension is replicating the Array across the DEs ! along this direction. ! \item[{[distgridToPackedArrayMap]}] ! Upon return this list holds the indices of the Array dimensions in packed ! format against which the DistGrid dimensions are mapped. ! {\tt distgridToPackedArrayMap} must be allocated to be of size ! {\tt dimCount}. An entry of zero indicates that the respective DistGrid ! dimension is replicating the Array across the DEs along this direction. ! \item[{[arrayToDistGridMap]}] ! Upon return this list holds the DistGrid dimensions against which the ! Array dimensions are mapped. {\tt arrayToDistGridMap} must be allocated ! to be of size {\tt rank}. An entry of zero indicates that the respective ! Array dimension is not decomposed, rendering it a tensor dimension. ! \item[{[undistLBound]}] ! \begin{sloppypar} ! Upon return this array holds the lower bounds of the undistributed ! dimensions of the Array. {\tt UndistLBound} must be allocated to be ! of size {\tt rank-dimCount}. ! \end{sloppypar} ! \item[{[undistUBound]}] ! \begin{sloppypar} ! Upon return this array holds the upper bounds of the undistributed ! dimensions of the Array. {\tt UndistUBound} must be allocated to be ! of size {\tt rank-dimCount}. ! \end{sloppypar} ! \item[{[exclusiveLBound]}] ! \begin{sloppypar} ! Upon return this holds the lower bounds of the exclusive regions for ! all PET-local DEs. {\tt exclusiveLBound} must be allocated to be ! of size {\tt (dimCount, localDeCount)}. ! \end{sloppypar} ! \item[{[exclusiveUBound]}] ! \begin{sloppypar} ! Upon return this holds the upper bounds of the exclusive regions for ! all PET-local DEs. {\tt exclusiveUBound} must be allocated to be ! of size {\tt (dimCount, localDeCount)}. ! \end{sloppypar} ! \item[{[computationalLBound]}] ! Upon return this holds the lower bounds of the computational regions for ! all PET-local DEs. {\tt computationalLBound} must be allocated to be ! of size {\tt (dimCount, localDeCount)}. ! \item[{[computationalUBound]}] ! Upon return this holds the upper bounds of the computational regions for ! all PET-local DEs. {\tt computationalUBound} must be allocated to be ! of size {\tt (dimCount, localDeCount)}. ! \item[{[totalLBound]}] ! Upon return this holds the lower bounds of the total regions for ! all PET-local DEs. {\tt totalLBound} must be allocated to be ! of size {\tt (dimCount, localDeCount)}. ! \item[{[totalUBound]}] ! Upon return this holds the upper bounds of the total regions for ! all PET-local DEs. {\tt totalUBound} must be allocated to be ! of size {\tt (dimCount, localDeCount)}. ! \item[{[computationalLWidth]}] ! Upon return this holds the lower width of the computational regions for ! all PET-local DEs. {\tt computationalLWidth} must be allocated to be ! of size {\tt (dimCount, localDeCount)}. ! \item[{[computationalUWidth]}] ! Upon return this holds the upper width of the computational regions for ! all PET-local DEs. {\tt computationalUWidth} must be allocated to be ! of size {\tt (dimCount, localDeCount)}. ! \item[{[totalLWidth]}] ! \begin{sloppypar} ! Upon return this holds the lower width of the total memory regions for ! all PET-local DEs. {\tt totalLWidth} must be allocated to be ! of size {\tt (dimCount, localDeCount)}. ! \end{sloppypar} ! \item[{[totalUWidth]}] ! \begin{sloppypar} ! Upon return this holds the upper width of the total memory regions for ! all PET-local DEs. {\tt totalUWidth} must be allocated to be ! of size {\tt (dimCount, localDeCount)}. ! \end{sloppypar} ! \item[{[distgrid]}] ! Upon return this holds the associated {\tt ESMF\_DistGrid} object. ! \item[{[dimCount]}] ! Number of dimensions (rank) of {\tt distgrid}. ! \item[{[tileCount]}] ! Number of tiles in {\tt distgrid}. ! \item[{[minIndexPTile]}] ! Lower index space corner per {\tt dim}, per {\tt tile}, with ! {\tt size(minIndexPTile) == (/dimCount, tileCount/)}. ! \item[{[maxIndexPTile]}] ! Upper index space corner per {\tt dim}, per {\tt tile}, with ! {\tt size(maxIndexPTile) == (/dimCount, tileCount/)}. ! \item[{[deToTileMap]}] ! List of tile id numbers, one for each DE, with ! {\tt size(deToTileMap) == (/deCount/)} ! \item[{[indexCountPDe]}] ! \begin{sloppypar} ! Array of extents per {\tt dim}, per {\tt de}, with ! {\tt size(indexCountPDe) == (/dimCount, deCount/)}. ! \end{sloppypar} ! \item[{[delayout]}] ! Upon return this holds the associated {\tt ESMF\_DELayout} object. ! \item[{[deCount]}] ! Upon return this holds the total number of DEs defined in the DELayout ! associated with the Array object. ! \item[{[localDeCount]}] ! Upon return this holds the number of PET-local DEs defined in the ! DELayout associated with the Array object. ! \item[{[localDeList]}] ! Upon return this holds the list of DE ids for the PET-local ! DEs defined in the DELayout associated with the Array object. ! The provided argument must be of size {\tt localDeCount}. ! \item [{[name]}] ! Name of the Array object. ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOP !------------------------------------------------------------------------------ integer :: localrc ! local return code type(ESMF_TypeKind_Flag) :: opt_typekind ! helper variable integer :: opt_rank ! helper variable type(ESMF_Pointer), pointer :: opt_localarrayPtrList(:) ! helper variable integer :: len_localarrayPtrList, i ! helper variable type(ESMF_InterfaceInt) :: distgridToArrayMapArg ! helper variable type(ESMF_InterfaceInt) :: distgridToPackedArrayMapArg ! helper var type(ESMF_InterfaceInt) :: arrayToDistGridMapArg ! helper variable type(ESMF_InterfaceInt) :: undistLBoundArg ! helper variable type(ESMF_InterfaceInt) :: undistUBoundArg ! helper variable type(ESMF_InterfaceInt) :: exclusiveLBoundArg ! helper variable type(ESMF_InterfaceInt) :: exclusiveUBoundArg ! helper variable type(ESMF_InterfaceInt) :: computationalLBoundArg ! helper variable type(ESMF_InterfaceInt) :: computationalUBoundArg ! helper variable type(ESMF_InterfaceInt) :: totalLBoundArg ! helper variable type(ESMF_InterfaceInt) :: totalUBoundArg ! helper variable type(ESMF_InterfaceInt) :: computationalLWidthArg ! helper variable type(ESMF_InterfaceInt) :: computationalUWidthArg ! helper variable type(ESMF_InterfaceInt) :: totalLWidthArg ! helper variable type(ESMF_InterfaceInt) :: totalUWidthArg ! helper variable type(ESMF_DistGrid) :: opt_distgrid ! helper variable type(ESMF_DELayout) :: opt_delayout ! helper variable ! Initialize return code localrc = ESMF_RC_NOT_IMPL if (present(rc)) rc = ESMF_RC_NOT_IMPL ! Check init status of arguments ESMF_INIT_CHECK_DEEP(ESMF_ArrayGetInit, array, rc) ! Deal with (optional) array arguments if (present(localarrayList)) then len_localarrayPtrList = size(localarrayList) allocate(opt_localarrayPtrList(len_localarrayPtrList)) else len_localarrayPtrList = 0 allocate(opt_localarrayPtrList(1)) endif distgridToArrayMapArg = ESMF_InterfaceIntCreate(distgridToArrayMap, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return distgridToPackedArrayMapArg = & ESMF_InterfaceIntCreate(distgridToPackedArrayMap, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return arrayToDistGridMapArg = ESMF_InterfaceIntCreate(arrayToDistGridMap, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return undistLBoundArg = ESMF_InterfaceIntCreate(undistLBound, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return undistUBoundArg = ESMF_InterfaceIntCreate(undistUBound, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return exclusiveLBoundArg = ESMF_InterfaceIntCreate(farray2D=exclusiveLBound, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return exclusiveUBoundArg = ESMF_InterfaceIntCreate(farray2D=exclusiveUBound, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return computationalLBoundArg = & ESMF_InterfaceIntCreate(farray2D=computationalLBound, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return computationalUBoundArg = & ESMF_InterfaceIntCreate(farray2D=computationalUBound, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return totalLBoundArg = ESMF_InterfaceIntCreate(farray2D=totalLBound, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return totalUBoundArg = ESMF_InterfaceIntCreate(farray2D=totalUBound, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return computationalLWidthArg = & ESMF_InterfaceIntCreate(farray2D=computationalLWidth, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return computationalUWidthArg = & ESMF_InterfaceIntCreate(farray2D=computationalUWidth, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return totalLWidthArg = ESMF_InterfaceIntCreate(farray2D=totalLWidth, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return totalUWidthArg = ESMF_InterfaceIntCreate(farray2D=totalUWidth, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Call into the C++ interface, which will sort out optional arguments call c_ESMC_ArrayGet(array, opt_typekind, opt_rank, opt_localarrayPtrList, & len_localarrayPtrList, opt_distgrid, opt_delayout, indexflag, & distgridToArrayMapArg, distgridToPackedArrayMapArg, & arrayToDistGridMapArg, & undistLBoundArg, undistUBoundArg, & exclusiveLBoundArg, exclusiveUBoundArg, & computationalLBoundArg, computationalUBoundArg, & totalLBoundArg, totalUBoundArg, & computationalLWidthArg, computationalUWidthArg, & totalLWidthArg, totalUWidthArg, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set init code for deep C++ objects call ESMF_DELayoutSetInitCreated(opt_delayout, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return if (present(delayout)) then delayout = opt_delayout ! copy deep C++ pointer endif call ESMF_DistGridSetInitCreated(opt_distgrid, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return if (present(distgrid)) then distgrid = opt_distgrid ! copy deep C++ pointer endif if (present(localarrayList)) then do i=1, len_localarrayPtrList call ESMF_LocalArraySetThis(localarrayList(i), opt_localarrayPtrList(i), & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_LocalArraySetInitCreated(localarrayList(i), rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return enddo endif ! Garbage collection deallocate(opt_localarrayPtrList) call ESMF_InterfaceIntDestroy(distgridToArrayMapArg, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterfaceIntDestroy(distgridToPackedArrayMapArg, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterfaceIntDestroy(arrayToDistGridMapArg, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterfaceIntDestroy(undistLBoundArg, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterfaceIntDestroy(undistUBoundArg, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterfaceIntDestroy(exclusiveLBoundArg, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterfaceIntDestroy(exclusiveUBoundArg, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterfaceIntDestroy(computationalLBoundArg, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterfaceIntDestroy(computationalUBoundArg, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterfaceIntDestroy(totalLBoundArg, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterfaceIntDestroy(totalUBoundArg, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterfaceIntDestroy(computationalLWidthArg, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterfaceIntDestroy(computationalUWidthArg, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterfaceIntDestroy(totalLWidthArg, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterfaceIntDestroy(totalUWidthArg, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Special call to get name out of Base class if (present(name)) then call c_ESMC_GetName(array, name, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Obtain DistGrid information call ESMF_DistGridGet(opt_distgrid, dimCount=dimCount, & tileCount=tileCount, minIndexPTile=minIndexPTile, & maxIndexPTile=maxIndexPTile, deToTileMap=deToTileMap, & indexCountPDe=indexCountPDe, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Obtain DELayout information call ESMF_DELayoutGet(opt_delayout, deCount=deCount, & localDeCount=localDeCount, localDeList=localDeList, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Deal with option arrayspec, typekind, rank arguments if (present(typekind)) typekind = opt_typekind if (present(rank)) rank = opt_rank if (present(arrayspec)) then call ESMF_ArraySpecSet(arrayspec, typekind=opt_typekind, rank=opt_rank, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Return successfully if (present(rc)) rc = ESMF_SUCCESS end subroutine ESMF_ArrayGetDefault !------------------------------------------------------------------------------ ! -------------------------- ESMF-public method ------------------------------- ^undef ESMF_METHOD ^define ESMF_METHOD "ESMF_ArrayGetPLocalDePDim()" !BOP ! !IROUTINE: ESMF_ArrayGet - Access to Array internals per dim per local DE ! !INTERFACE: ! Private name; call using ESMF_ArrayGet() subroutine ESMF_ArrayGetPLocalDePDim(array, dim, keywordEnforcer, localDe, & indexCount, indexList, rc) ! ! !ARGUMENTS: type(ESMF_Array), intent(in) :: array integer, intent(in) :: dim type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below integer, intent(in), optional :: localDe integer, intent(out), optional :: indexCount integer, intent(out), optional :: indexList(:) integer, intent(out), optional :: rc ! ! !STATUS: ! \apiStatusCompatible ! ! !DESCRIPTION: ! Get internal information per local DE, per dim. ! ! This interface works for any number of DEs per PET. ! ! The arguments are: ! \begin{description} ! \item[array] ! Queried {\tt ESMF\_Array} object. ! \item[dim] ! Dimension for which information is requested. {\tt [1,..,dimCount]} ! \item[{[localDe]}] ! Local DE for which information is requested. {\tt [0,..,localDeCount-1]}. ! For {\tt localDeCount==1} the {\tt localDe} argument may be omitted, ! in which case it will default to {\tt localDe=0}. ! \item[{[indexCount]}] ! DistGrid indexCount associated with {\tt localDe, dim}. ! \item[{[indexList]}] ! List of DistGrid tile-local indices for {\tt localDe} along dimension ! {\tt dim}. ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOP !------------------------------------------------------------------------------ integer :: localrc ! local return code type(ESMF_DistGrid) :: distgrid ! helper variable integer :: dimCount ! helper variable integer, allocatable:: indexCountInternal(:,:) ! helper variable integer :: count ! helper variable type(ESMF_DELayout) :: delayout ! helper variable integer :: deCount ! helper variable integer :: localDeCount ! helper variable integer :: localDeArg ! helper variable integer, allocatable:: localDeList(:) ! helper variable integer :: de ! helper variable integer :: rank ! helper variable integer, allocatable:: arrayToDistgridMap(:) ! helper variable integer :: distgridDim ! helper variable ! Initialize return code localrc = ESMF_RC_NOT_IMPL if (present(rc)) rc = ESMF_RC_NOT_IMPL ! Check init status of arguments ESMF_INIT_CHECK_DEEP(ESMF_ArrayGetInit, array, rc) ! Obtain auxiliary information call ESMF_ArrayGet(array, rank=rank, distgrid=distgrid, dimCount=dimCount, & delayout=delayout, deCount=deCount, localDeCount=localDeCount, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Deal with optional localDe argument if (present(localDe)) then localDeArg = localDe else if (localDeCount == 1) then localDeArg = 0 ! default else call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_OPT, & msg="- must provide optional localDe argument for localDeCount > 1", & ESMF_CONTEXT, rcToReturn=rc) endif endif ! Check that localDeArg is within limits if (localDeArg < 0 .or. localDeArg > localDeCount-1) then call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_OUTOFRANGE, & msg="- localDe out of range", & ESMF_CONTEXT, rcToReturn=rc) return endif if (dim < 1 .or. dim > rank) then call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_VALUE, & msg="dim argument out of range", & ESMF_CONTEXT, rcToReturn=rc) return endif allocate(arrayToDistgridMap(rank)) call ESMF_ArrayGet(array, arrayToDistgridMap=arrayToDistgridMap, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return distgridDim = arrayToDistgridMap(dim) deallocate(arrayToDistgridMap) if (distgridDim == 0) then call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_VALUE, & msg="dim argument does not map to a DistGrid dimension", & ESMF_CONTEXT, rcToReturn=rc) return endif allocate(indexCountInternal(dimCount,0:deCount-1)) call ESMF_DistGridGet(distgrid, indexCountPDe=indexCountInternal, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return allocate(localDeList(0:localDeCount-1)) call ESMF_DELayoutGet(delayout, localDeList=localDeList, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return de=localDeList(localDeArg) deallocate(localDeList) count = indexCountInternal(distgridDim, de) deallocate(indexCountInternal) ! Set indexCount output if (present(indexCount)) then indexCount = count endif ! Obtain indexList if (present(indexList)) then if (size(indexList) < count) then call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, & msg="indexList argument dimensioned too small", & ESMF_CONTEXT, rcToReturn=rc) return endif call ESMF_DistGridGet(distgrid, localDe=localDeArg, dim=dim, & indexList=indexList, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Return successfully if (present(rc)) rc = ESMF_SUCCESS end subroutine ESMF_ArrayGetPLocalDePDim !------------------------------------------------------------------------------ #define ArrayGetFPtrDoc() \ ! -------------------------- ESMF-public method ----------------------------- @\ !BOP @\ ! !IROUTINE: ESMF_ArrayGet - Access to PET-local Array tile via Fortran array pointer @\ @\ ! !INTERFACE: @\ ! ! Private name; call using ESMF_ArrayGet() @\ ! subroutine ESMF_ArrayGetFPtr(array, keywordEnforcer, localDe, & @\ ! farrayPtr, rc) @\ ! @\ ! !ARGUMENTS: @\ ! type(ESMF_Array), intent(in) :: array @\ ! type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below @\ ! integer, intent(in), optional :: localDe @\ ! (ESMF_KIND_), pointer :: farrayPtr() @\ ! integer, intent(out), optional :: rc @\ ! @\ ! !STATUS: @\ ! \apiStatusCompatible @\ ! @\ ! !DESCRIPTION: @\ ! Access Fortran array pointer to the specified DE-local memory allocation of @\ ! the Array object. @\ ! @\ ! The arguments are: @\ ! \begin{description} @\ ! \item[array] @\ ! Queried {\tt ESMF\_Array} object. @\ ! \item[{[localDe]}] @\ ! Local DE for which information is requested. {\tt [0,..,localDeCount-1]}. @\ ! For {\tt localDeCount==1} the {\tt localDe} argument may be omitted, @\ ! in which case it will default to {\tt localDe=0}. @\ ! \item[farrayPtr] @\ ! Upon return, {\tt farrayPtr} points to the DE-local data allocation of @\ ! {\tt localDe} in {\tt array}. It depends on the specific entry point @\ ! of {\tt ESMF\_ArrayCreate()} used during {\tt array} creation, which @\ ! Fortran operations are supported on the returned {\tt farrayPtr}. See @\ ! \ref{Array:rest} for more details. @\ ! \item[{[rc]}] @\ ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. @\ ! \end{description} @\ ! @\ !EOP @\ !---------------------------------------------------------------------------- @\ #define ArrayGetFPtrMacro(mtype, mtypekind, mrank, mdim, mlen, mrng, mloc) \ ! -------------------------- ESMF-public method ----------------------------- @\ ^undef ESMF_METHOD @\ ^define ESMF_METHOD "ESMF_ArrayGetFPtr" @\ subroutine ESMF_ArrayGetFPtr##mrank##D##mtypekind(array, keywordEnforcer, & @\ localDe, farrayPtr, rc) @\ @\ type(ESMF_Array), intent(in) :: array @\ type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below @\ integer, intent(in), optional :: localDe @\ mtype (ESMF_KIND_##mtypekind),dimension(mdim),pointer :: farrayPtr @\ integer, intent(out), optional :: rc @\ @\ ! Local variables @\ integer :: localrc ! local return code @\ integer :: rank @\ type(ESMF_TypeKind_Flag) :: typekind @\ type(ESMF_LocalArray) :: localarray @\ @\ ! Initialize return code @\ localrc = ESMF_RC_NOT_IMPL @\ if (present(rc)) rc = ESMF_RC_NOT_IMPL @\ @\ ! Check init status of arguments @\ ESMF_INIT_CHECK_DEEP(ESMF_ArrayGetInit, array, rc) @\ @\ ! Check consistency @\ call ESMF_ArrayGet(array, typekind=typekind, rank=rank, rc=localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ ! Require farrayPtr typekind to match Array typekind @\ if (typekind /= ESMF_TYPEKIND_##mtypekind) then @\ call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, & @\ msg="- farrayPtr typekind does not match Array typekind", & @\ ESMF_CONTEXT, rcToReturn=rc) @\ return @\ endif @\ ! Require farrayPtr rank to match Array rank @\ if (rank /= mrank) then @\ call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, & @\ msg="- farrayPtr rank does not match Array rank", & @\ ESMF_CONTEXT, rcToReturn=rc) @\ return @\ endif @\ @\ ! Obtain the native Fortran array pointer via the LocalArray interface @\ call ESMF_ArrayGet(array, localDe=localDe, localarray=localarray, rc=localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ call ESMF_LocalArrayGet(localarray, farrayPtr, datacopyflag=ESMF_DATACOPY_REFERENCE, rc=localrc) @\ if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & @\ ESMF_CONTEXT, rcToReturn=rc)) return @\ @\ ! Return successfully @\ if (present(rc)) rc = ESMF_SUCCESS @\ @\ end subroutine ESMF_ArrayGetFPtr##mrank##D##mtypekind @\ !---------------------------------------------------------------------------- @\ TypeKindRankDeclarationMacro(ArrayGetFPtr) ! -------------------------- ESMF-public method ------------------------------- ^undef ESMF_METHOD ^define ESMF_METHOD "ESMF_ArrayGetLocalArray()" !BOP ! !IROUTINE: ESMF_ArrayGet - Access to PET-local Array tile via LocalArray object. ! !INTERFACE: ! Private name; call using ESMF_ArrayGet() subroutine ESMF_ArrayGetLocalArray(array, keywordEnforcer, localDe, localarray, rc) ! ! !ARGUMENTS: type(ESMF_Array), intent(in) :: array type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below integer, intent(in), optional :: localDe type(ESMF_LocalArray), intent(inout) :: localarray integer, intent(out), optional :: rc ! ! !STATUS: ! \apiStatusCompatible ! ! !DESCRIPTION: ! Provide access to {\tt ESMF\_LocalArray} object that holds data for ! the specified local DE. ! ! The arguments are: ! \begin{description} ! \item[array] ! Queried {\tt ESMF\_Array} object. ! \item[{[localDe]}] ! Local DE for which information is requested. {\tt [0,..,localDeCount-1]}. ! For {\tt localDeCount==1} the {\tt localDe} argument may be omitted, ! in which case it will default to {\tt localDe=0}. ! \item[localarray] ! Upon return {\tt localarray} refers to the DE-local data allocation of ! {\tt array}. ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOP !------------------------------------------------------------------------------ integer :: localrc ! local return code type(ESMF_DELayout) :: delayout integer :: localDeCount integer :: localDeArg type(ESMF_LocalArray), allocatable :: localarrayList(:) ! Initialize return code localrc = ESMF_RC_NOT_IMPL if (present(rc)) rc = ESMF_RC_NOT_IMPL ! Check init status of arguments ESMF_INIT_CHECK_DEEP(ESMF_ArrayGetInit, array, rc) ! Use general Get() method to obtain information call ESMF_ArrayGet(array, delayout=delayout, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_DELayoutGet(delayout, localDeCount=localDeCount, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Sanity check localDeCount if (localDeCount <= 0) then call ESMF_LogSetError(rcToCheck=ESMF_RC_CANNOT_GET, & msg="- localDeCount <= 0 prohibits request", & ESMF_CONTEXT, rcToReturn=rc) return endif ! Deal with optional localDe argument if (present(localDe)) then localDeArg = localDe else if (localDeCount == 1) then localDeArg = 0 ! default else call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_OPT, & msg="- must provide optional localDe argument for localDeCount > 1", & ESMF_CONTEXT, rcToReturn=rc) endif endif ! Check that localDeArg is within limits if (localDeArg < 0 .or. localDeArg > localDeCount-1) then call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_OUTOFRANGE, & msg="- localDe out of range", & ESMF_CONTEXT, rcToReturn=rc) return endif ! get localArray via localarrayList allocate(localarrayList(localDeCount)) ! basis 1 call ESMF_ArrayGet(array, localarrayList=localarrayList, rc=rc) ! copy the contents, i.e. the C pointer localarray = localarrayList(localDeArg+1) ! shift localDe index to basis 1 deallocate(localarrayList) ! Return successfully if (present(rc)) rc = ESMF_SUCCESS end subroutine ESMF_ArrayGetLocalArray !------------------------------------------------------------------------------ ! -------------------------- ESMF-public method ------------------------------- ^undef ESMF_METHOD ^define ESMF_METHOD "ESMF_ArrayGetTotalElementMask1D()" !BOPI ! !IROUTINE: ESMF_ArrayGet - Get Array internals for local DE ! !INTERFACE: ! Private name; call using ESMF_ArrayGet() subroutine ESMF_ArrayGetTotalElementMask1D(array, routehandlelist, localDe, & totalElementMask, keywordEnforcer, rc) ! ! !ARGUMENTS: type(ESMF_Array), intent(in) :: array type(ESMF_RouteHandle), intent(in) :: routehandlelist(:) integer, intent(in) :: localDe integer, target, intent(out) :: totalElementMask(:) type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Get internal information. ! ! The arguments are: ! \begin{description} ! \item[array] ! Queried {\tt ESMF\_Array} object. ! \end{description} !EOPI !------------------------------------------------------------------------------ integer :: localrc ! local return code ! Initialize return code if (present(rc)) rc = ESMF_RC_NOT_IMPL localrc = ESMF_RC_NOT_IMPL end subroutine ESMF_ArrayGetTotalElementMask1D !------------------------------------------------------------------------------ ! -------------------------- ESMF-public method ------------------------------- ^undef ESMF_METHOD ^define ESMF_METHOD "ESMF_ArrayGetTotalElementMask2D()" !BOPI ! !IROUTINE: ESMF_ArrayGet - Get Array internals for local DE ! !INTERFACE: ! Private name; call using ESMF_ArrayGet() subroutine ESMF_ArrayGetTotalElementMask2D(array, routehandlelist, localDe, & totalElementMask, keywordEnforcer, rc) ! ! !ARGUMENTS: type(ESMF_Array), intent(in) :: array type(ESMF_RouteHandle), intent(in) :: routehandlelist(:) integer, intent(in) :: localDe integer, target, intent(out) :: totalElementMask(:,:) type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Get internal information. ! ! The arguments are: ! \begin{description} ! \item[array] ! Queried {\tt ESMF\_Array} object. ! \end{description} !EOPI !------------------------------------------------------------------------------ integer :: localrc ! local return code ! Initialize return code if (present(rc)) rc = ESMF_RC_NOT_IMPL localrc = ESMF_RC_NOT_IMPL end subroutine ESMF_ArrayGetTotalElementMask2D !------------------------------------------------------------------------------ ! -------------------------- ESMF-public method ------------------------------- ^undef ESMF_METHOD ^define ESMF_METHOD "ESMF_ArrayGetTotalElementMask3D()" !BOPI ! !IROUTINE: ESMF_ArrayGet - Get Array internals for local DE ! !INTERFACE: ! Private name; call using ESMF_ArrayGet() subroutine ESMF_ArrayGetTotalElementMask3D(array, routehandlelist, localDe, & totalElementMask, keywordEnforcer, rc) ! ! !ARGUMENTS: type(ESMF_Array), intent(in) :: array type(ESMF_RouteHandle), intent(in) :: routehandlelist(:) integer, intent(in) :: localDe integer, target, intent(out) :: totalElementMask(:,:,:) type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Get internal information. ! ! The arguments are: ! \begin{description} ! \item[array] ! Queried {\tt ESMF\_Array} object. ! \end{description} !EOPI !------------------------------------------------------------------------------ integer :: localrc ! local return code ! Initialize return code if (present(rc)) rc = ESMF_RC_NOT_IMPL localrc = ESMF_RC_NOT_IMPL end subroutine ESMF_ArrayGetTotalElementMask3D !------------------------------------------------------------------------------ ! -------------------------- ESMF-public method ------------------------------- ^undef ESMF_METHOD ^define ESMF_METHOD "ESMF_ArrayGetHalo()" !BOPI ! !IROUTINE: ESMF_ArrayGet - Get information about a stored halo operation ! !INTERFACE: ! Private name; call using ESMF_ArrayGet() subroutine ESMF_ArrayGetHalo(array, routehandle, keywordEnforcer, zeroregion, & haloLDepth, haloUDepth, rc) ! ! !ARGUMENTS: type(ESMF_Array), intent(in) :: array type(ESMF_RouteHandle), intent(in) :: routehandle type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below type(ESMF_Region_Flag), intent(out), optional :: zeroregion integer, target, intent(out), optional :: haloLDepth(:) integer, target, intent(out), optional :: haloUDepth(:) integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Get Fortran pointer to DE-local memory regions in Array object. ! ! This interface requires that exactly 1 DE is associated with the calling PET. ! An error will be returned if this condition is not met. ! ! The arguments are: ! \begin{description} ! \item[array] ! Queried {\tt ESMF\_Array} object. ! \item [routehandle] ! Handle to the stored Route ! \item [{[zeroregion]}] ! Specifies the reference for halo width arguments: ! {\tt ESMF\_STARTREGION\_EXCLUSIVE} or {\tt ESMF\_STARTREGION\_COMPUTATIONAL} ! (default). ! \item[{[haloLDepth]}] ! This vector argument must have dimCount elements, where dimCount is ! specified in distgrid. It specifies the lower corner of the total data ! region with respect to the lower corner of the computational region ! or exclusive region (depending on {\tt zeroregion}. ! \item[{[haloUDepth]}] ! This vector argument must have dimCount elements, where dimCount is ! specified in distgrid. It specifies the upper corner of the total data ! region with respect to the upper corner of the computational region ! or exclusive region (depending on {\tt zeroregion}. ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc ! local return code ! Initialize return code if (present(rc)) rc = ESMF_RC_NOT_IMPL localrc = ESMF_RC_NOT_IMPL zeroregion = ESMF_REGION_EMPTY ! quiet down compiler warnings while not fully implemented end subroutine ESMF_ArrayGetHalo !------------------------------------------------------------------------------ ! -------------------------- ESMF-internal method ----------------------------- ^undef ESMF_METHOD ^define ESMF_METHOD "ESMF_ArrayConstructPioDof()" !BOPI ! !IROUTINE: ESMF_ArrayConstructPioDof - Construct PIO DOF list for localDe ! !INTERFACE: subroutine ESMF_ArrayConstructPioDof(array, localDe, pioDofList, & pioDofCount, rc) ! ! !ARGUMENTS: type(ESMF_Array), intent(in) :: array integer, intent(in), optional :: localDe integer, target, intent(out), optional :: pioDofList(:) integer, intent(out), optional :: pioDofCount integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Construct PIO DOF list from Array for localDe. ! ! The arguments are: ! \begin{description} ! \item[array] ! {\tt ESMF\_Array} object. ! \item[{[localDe]}] ! Local DE for which information is requested. {\tt [0,..,localDeCount-1]}. ! Default is localDe 0. ! \item[{[pioDofList]}] ! List that holds PIO DOF entries on return. ! \item[{[pioDofCount]}] ! Number of elements in {\tt pioDofList}. ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc ! local return code type(ESMF_DELayout) :: delayout integer :: localDeCount integer :: localDeArg ! helper variable type(ESMF_InterfaceInt) :: pioDofListArg ! helper variable ! initialize return code; assume routine not implemented localrc = ESMF_RC_NOT_IMPL if (present(rc)) rc = ESMF_RC_NOT_IMPL ! Check init status of arguments ESMF_INIT_CHECK_DEEP(ESMF_ArrayGetInit, array, rc) ! Deal with optional localDe argument if (present(localDe)) then localDeArg = localDe else call ESMF_ArrayGet(array, delayout=delayout, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_DELayoutGet(delayout, localDeCount=localDeCount, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return if (localDeCount == 1) then localDeArg = 0 ! default else call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_OPT, & msg="- must provide optional localDe argument for localDeCount > 1", & ESMF_CONTEXT, rcToReturn=rc) endif endif ! Deal with (optional) array arguments pioDofListArg = ESMF_InterfaceIntCreate(pioDofList, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! call into the C++ interface, which will sort out optional arguments call c_ESMC_ArrayConstructPioDof(array, localDeArg, pioDofListArg, & pioDofCount, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! garbage collection call ESMF_InterfaceIntDestroy(pioDofListArg, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! return successfully if (present(rc)) rc = ESMF_SUCCESS end subroutine ESMF_ArrayConstructPioDof !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ end module ESMF_ArrayGetMod