! $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_Grid.F90"
!
! ESMF Grid Module
module ESMF_GridMod
!
!==============================================================================
!
! This file contains the Grid class definition and all Grid class
! methods.
!
!------------------------------------------------------------------------------
! INCLUDES
#include "ESMF.h"
!==============================================================================
!BOPI
! !MODULE: ESMF_GridMod - Grid class
!
! !DESCRIPTION:
!
! The code in this file implements the {\tt ESMF\_Grid} class.
!
!------------------------------------------------------------------------------
! !USES:
use ESMF_UtilTypesMod
use ESMF_BaseMod ! ESMF base class
use ESMF_ArrayMod
use ESMF_ArrayBundleMod
use ESMF_RHandleMod
use ESMF_LocalArrayMod ! ESMF local array class
use ESMF_InitMacrosMod ! ESMF initializer macros
use ESMF_LogErrMod ! ESMF error handling
use ESMF_VMMod
use ESMF_DELayoutMod
use ESMF_StaggerLocMod
use ESMF_DistGridMod
use ESMF_F90InterfaceMod ! ESMF F90-C++ interface helper
use ESMF_ArraySpecMod
use ESMF_IOScripMod
use ESMF_IOGridspecMod
use ESMF_IOGridmosaicMod
use ESMF_IOUtilMod
use ESMF_UtilCubedSphereMod
use ESMF_IOFileTypeCheckMod
use ESMF_InfoMod, only : ESMF_Info, ESMF_InfoGetFromPointer, ESMF_InfoUpdate
#ifdef ESMF_NETCDF
use netcdf
#endif
! NEED TO ADD MORE HERE
implicit none
!------------------------------------------------------------------------------
! !PRIVATE TYPES:
private
!------------------------------------------------------------------------------
! ! ESMF_Grid
!
!------------------------------------------------------------------------------
! F90 class type to hold pointer to C++ object
type ESMF_Grid
#ifndef ESMF_NO_SEQUENCE
sequence
#endif
type(ESMF_Pointer) :: this
ESMF_INIT_DECLARE
end type
!------------------------------------------------------------------------------
! ! ESMF_GridStatus_Flag
!
!------------------------------------------------------------------------------
type ESMF_GridStatus_Flag
#ifndef ESMF_NO_SEQUENCE
sequence
#endif
! private
integer :: gridstatus
end type
type(ESMF_GridStatus_Flag), parameter :: &
ESMF_GRIDSTATUS_INVALID=ESMF_GridStatus_Flag(-1), &
ESMF_GRIDSTATUS_UNINIT=ESMF_GridStatus_Flag(0), &
ESMF_GRIDSTATUS_EMPTY=ESMF_GridStatus_Flag(1), &
ESMF_GRIDSTATUS_COMPLETE=ESMF_GridStatus_Flag(2)
!------------------------------------------------------------------------------
! ! ESMF_GridItem_Flag
!
!------------------------------------------------------------------------------
! There is an assignment operator for the flag, please check that
! if you are making changes to this flag.
type ESMF_GridItem_Flag
#ifndef ESMF_NO_SEQUENCE
sequence
#endif
! private
integer :: gridItem
end type
type(ESMF_GridItem_Flag), parameter :: &
ESMF_GRIDITEM_INVALID=ESMF_GridItem_Flag(-2), &
ESMF_GRIDITEM_UNINIT=ESMF_GridItem_Flag(-1), &
ESMF_GRIDITEM_MASK=ESMF_GridItem_Flag(0), &
ESMF_GRIDITEM_AREA=ESMF_GridItem_Flag(1), &
DEPREC_ESMF_GRIDITEM_AREAM=ESMF_GridItem_Flag(2), & ! DEPRECATED: If using, please email esmf support.
DEPREC_ESMF_GRIDITEM_FRAC=ESMF_GridItem_Flag(3) ! DEPRECATED: If using, please email esmf support.
integer, parameter :: ESMF_GRIDITEM_COUNT=2
!------------------------------------------------------------------------------
! ! ESMF_GridConn_Flag
!
!------------------------------------------------------------------------------
type ESMF_GridConn_Flag
#ifndef ESMF_NO_SEQUENCE
sequence
#endif
! private
integer :: gridconn
end type
type(ESMF_GridConn_Flag), parameter :: &
ESMF_GRIDCONN_NONE = ESMF_GridConn_Flag(0), &
ESMF_GRIDCONN_PERIODIC = ESMF_GridConn_Flag(1), &
ESMF_GRIDCONN_POLE = ESMF_GridConn_Flag(2), &
ESMF_GRIDCONN_BIPOLE = ESMF_GridConn_Flag(3)
!------------------------------------------------------------------------------
! ! ESMF_PoleKind_Flag
!
!------------------------------------------------------------------------------
type ESMF_PoleKind_Flag
#ifndef ESMF_NO_SEQUENCE
sequence
#endif
! private
integer :: polekind
end type
type(ESMF_PoleKind_Flag), parameter :: &
ESMF_POLEKIND_NONE = ESMF_PoleKind_Flag(0), &
ESMF_POLEKIND_MONOPOLE = ESMF_PoleKind_Flag(1), &
ESMF_POLEKIND_BIPOLE = ESMF_PoleKind_Flag(2)
!------------------------------------------------------------------------------
! ! ESMF_DefaultFlag
!
!------------------------------------------------------------------------------
! TODO: eventually move this elsewhere (e.g. Util)
type ESMF_DefaultFlag
#ifndef ESMF_NO_SEQUENCE
sequence
#endif
! private
integer :: defaultflag
end type
!------------------------------------------------------------------------------
! ! ESMF_GridDecompType
!
!------------------------------------------------------------------------------
type ESMF_GridDecompType
#ifndef ESMF_NO_SEQUENCE
sequence
#endif
! private
integer :: griddecomptype
end type
type (ESMF_GridDecompType), parameter :: &
ESMF_GRID_INVALID = ESMF_GridDecompType(1), &
ESMF_GRID_NONARBITRARY = ESMF_GridDecompType(2), &
ESMF_GRID_ARBITRARY = ESMF_GridDecompType(3)
!------------------------------------------------------------------------------
! ! Special dimenaion for Arbitrarily distributed dimension
!
!------------------------------------------------------------------------------
integer,parameter :: ESMF_DIM_ARB = -1
!------------------------------------------------------------------------------
! ! ESMF_GridMatch_Flag
!
!------------------------------------------------------------------------------
type ESMF_GridMatch_Flag
#ifndef ESMF_NO_SEQUENCE
sequence
#endif
! private
integer :: gridmatch
end type
type(ESMF_GridMatch_Flag), parameter :: &
ESMF_GRIDMATCH_INVALID=ESMF_GridMatch_Flag(0), &
ESMF_GRIDMATCH_NONE=ESMF_GridMatch_Flag(1), &
ESMF_GRIDMATCH_EXACT=ESMF_GridMatch_Flag(2), &
ESMF_GRIDMATCH_ALIAS=ESMF_GridMatch_Flag(3)
!------------------------------------------------------------------------------
!
! !PUBLIC TYPES:
!
public ESMF_Grid
public ESMF_GridConn_Flag, ESMF_GRIDCONN_NONE, ESMF_GRIDCONN_PERIODIC, &
ESMF_GRIDCONN_POLE, ESMF_GRIDCONN_BIPOLE
public ESMF_GridStatus_Flag, ESMF_GRIDSTATUS_INVALID, ESMF_GRIDSTATUS_UNINIT, &
ESMF_GRIDSTATUS_EMPTY, ESMF_GRIDSTATUS_COMPLETE
public ESMF_GridMatch_Flag, ESMF_GRIDMATCH_INVALID, &
ESMF_GRIDMATCH_NONE, ESMF_GRIDMATCH_EXACT, ESMF_GRIDMATCH_ALIAS
public ESMF_PoleKind_Flag, ESMF_POLEKIND_NONE, ESMF_POLEKIND_MONOPOLE, &
ESMF_POLEKIND_BIPOLE
public ESMF_GridItem_Flag, ESMF_GRIDITEM_INVALID, ESMF_GRIDITEM_UNINIT, &
ESMF_GRIDITEM_MASK, ESMF_GRIDITEM_AREA, &
DEPREC_ESMF_GRIDITEM_AREAM, DEPREC_ESMF_GRIDITEM_FRAC
public ESMF_DefaultFlag
public ESMF_GridDecompType, ESMF_GRID_INVALID, ESMF_GRID_NONARBITRARY, ESMF_GRID_ARBITRARY
!------------------------------------------------------------------------------
!
! !PUBLIC MEMBER FUNCTIONS:
!
!
! - ESMF-public methods:
public assignment(=)
public operator(==)
public operator(/=)
public operator(>)
public operator(>=)
public ESMF_GridAddCoord
public ESMF_GridCommit
public ESMF_GridCreate
public ESMF_GridEmptyCreate
public ESMF_GridEmptyComplete
! public ESMF_GridCreateShapeTile
public ESMF_GridCreateNoPeriDim
public ESMF_GridCreate1PeriDim
public ESMF_GridCreate2PeriDim
public ESMF_GridCreateNoPeriDimUfrm
public ESMF_GridCreate1PeriDimUfrm
public ESMF_GridCreateCubedSphere
public ESMF_GridCreateMosaic
public ESMF_GridDestroy
public ESMF_GridGet
public ESMF_GridGetCoord
public ESMF_GridGetCoordBounds
! public ESMF_GridGetCoordInd ! HOPEFULLY TEMPORARY SEPARATE INTERFACE
public ESMF_GridGetDecompType
public ESMF_GridIsCreated
public ESMF_GridSet
public ESMF_GridSetCoord
public ESMF_GridAddItem
public ESMF_GridGetItem
public ESMF_GridSetItem
public ESMF_GridGetItemBounds
public ESMF_GridGetIndex
! public ESMF_GridSetCommitShapeTile
public ESMF_GridSerialize
public ESMF_GridDeserialize
public ESMF_GridMatch
public ESMF_GridPrint
public ESMF_GridRedist
public ESMF_GridValidate
! public ESMF_GridTest ! For debugging
public ESMF_GridConvertIndex ! For Arbitrarily distributed grid only
public ESMF_ArrayCreateFromGrid
public ESMF_GridGetArrayInfo
public ESMF_OutputScripGridFile
public ESMF_DIM_ARB
! - ESMF-internal methods:
public ESMF_GridGetInit
!EOPI
!------------------------------------------------------------------------------
! The following line turns the CVS identifier string into a printable variable.
character(*), parameter, private :: version = &
'$Id$'
!==============================================================================
!
! INTERFACE BLOCKS
!
!==============================================================================
! -------------------------- ESMF-public method -------------------------------
!BOPI
! !IROUTINE: ESMF_GridAddCoord -- Generic interface
! !INTERFACE:
interface ESMF_GridAddCoord
! !PRIVATE MEMBER FUNCTIONS:
!
module procedure ESMF_GridAddCoordNoValues
! module procedure ESMF_GridAddCoordArrayList ! Currently not public
! !DESCRIPTION:
! This interface provides a single entry point for the various
! types of {\tt ESMF\_GridAddCoord} functions.
!EOPI
end interface
! -------------------------- ESMF-public method -------------------------------
!BOPI
! !IROUTINE: ESMF_GridAddItem -- Generic interface
! !INTERFACE:
interface ESMF_GridAddItem
! !PRIVATE MEMBER FUNCTIONS:
!
module procedure ESMF_GridAddItemNoValues
! !DESCRIPTION:
! This interface provides a single entry point for the various
! types of {\tt ESMF\_GridAddItem} functions.
!EOPI
end interface
! -------------------------- ESMF-public method -------------------------------
!BOPI
! !IROUTINE: ESMF_GridCreate -- Generic interface
! !INTERFACE:
interface ESMF_GridCreate
! !PRIVATE MEMBER FUNCTIONS:
!
module procedure ESMF_GridCreateCopyFromReg
module procedure ESMF_GridCreateCopyFromNewDG
module procedure ESMF_GridCreateFrmDistGrid
module procedure ESMF_GridCreateFrmDistGridArb
module procedure ESMF_GridCreateFrmNCFile
module procedure ESMF_GridCreateFrmNCFileDG
module procedure ESMF_GridCreateEdgeConnR
module procedure ESMF_GridCreateEdgeConnI
module procedure ESMF_GridCreateEdgeConnA
! !DESCRIPTION:
! This interface provides a single entry point for the various
! types of {\tt ESMF\_GridCreate} functions.
!EOPI
end interface
! -------------------------- ESMF-public method -------------------------------
!BOPI
! !IROUTINE: ESMF_GridEmptyComplete -- Generic interface
! !INTERFACE:
interface ESMF_GridEmptyComplete
! !PRIVATE MEMBER FUNCTIONS:
!
module procedure ESMF_GridEmptyCompleteEConnR
module procedure ESMF_GridEmptyCompleteEConnI
module procedure ESMF_GridEmptyCompleteEConnA
! !DESCRIPTION:
! This interface provides a single entry point for the various
! types of {\tt ESMF\_GridCreateShapeTile} functions.
!EOPI
end interface
! -------------------------- ESMF-public method -------------------------------
!BOPI
! !IROUTINE: ESMF_GridCreateShapeTile -- Generic interface
! !INTERFACE:
interface ESMF_GridCreateShapeTile
! !PRIVATE MEMBER FUNCTIONS:
!
module procedure ESMF_GridCreateShapeTileReg
module procedure ESMF_GridCreateShapeTileIrreg
module procedure ESMF_GridCreateShapeTileArb
! !DESCRIPTION:
! This interface provides a single entry point for the various
! types of {\tt ESMF\_GridCreateShapeTile} functions.
!EOPI
end interface
! -------------------------- ESMF-public method -------------------------------
!BOPI
! !IROUTINE: ESMF_GridCreateNoPeriDim -- Generic interface
! !INTERFACE:
interface ESMF_GridCreateNoPeriDim
! !PRIVATE MEMBER FUNCTIONS:
!
module procedure ESMF_GridCreateNoPeriDimR
module procedure ESMF_GridCreateNoPeriDimI
module procedure ESMF_GridCreateNoPeriDimA
! !DESCRIPTION:
! This interface provides a single entry point for the various
! types of {\tt ESMF\_GridCreateNoPeriodic} functions.
!EOPI
end interface
! -------------------------- ESMF-public method -------------------------------
!BOPI
! !IROUTINE: ESMF_GridCreateNoPeriDimUfrm -- Generic interface
! !INTERFACE:
interface ESMF_GridCreateNoPeriDimUfrm
! !PRIVATE MEMBER FUNCTIONS:
!
module procedure ESMF_GridCreateNoPeriDimUfrmR
! !DESCRIPTION:
! This interface provides a single entry point for the various
! types of {\tt ESMF\_GridCreateNoPeriDimUfrm} functions.
!EOPI
end interface
! -------------------------- ESMF-public method -------------------------------
!BOPI
! !IROUTINE: ESMF_GridCreate1PeriDimUfrm -- Generic interface
! !INTERFACE:
interface ESMF_GridCreate1PeriDimUfrm
! !PRIVATE MEMBER FUNCTIONS:
!
module procedure ESMF_GridCreate1PeriDimUfrmR
module procedure ESMF_GridCreate1PeriDimUfrmB
! !DESCRIPTION:
! This interface provides a single entry point for the various
! types of {\tt ESMF\_GridCreate1PeriDimUfrm} functions.
!EOPI
end interface
! -------------------------- ESMF-public method -------------------------------
!BOPI
! !IROUTINE: ESMF_GridCreate1PeriDim -- Generic interface
! !INTERFACE:
interface ESMF_GridCreate1PeriDim
! !PRIVATE MEMBER FUNCTIONS:
!
module procedure ESMF_GridCreate1PeriDimR
module procedure ESMF_GridCreate1PeriDimI
module procedure ESMF_GridCreate1PeriDimA
! !DESCRIPTION:
! This interface provides a single entry point for the various
! types of {\tt ESMF\_GridCreate1Periodic} functions.
!EOPI
end interface
! -------------------------- ESMF-public method -------------------------------
!BOPI
! !IROUTINE: ESMF_GridCreate2PeriDim -- Generic interface
! !INTERFACE:
interface ESMF_GridCreate2PeriDim
! !PRIVATE MEMBER FUNCTIONS:
!
module procedure ESMF_GridCreate2PeriDimR
module procedure ESMF_GridCreate2PeriDimI
module procedure ESMF_GridCreate2PeriDimA
! !DESCRIPTION:
! This interface provides a single entry point for the various
! types of {\tt ESMF\_GridCreate2Periodic} functions.
!EOPI
end interface
! -------------------------- ESMF-public method -------------------------------
!BOPI
! !IROUTINE: ESMF_GridCreateCubedSphere -- Generic interface
! !INTERFACE:
interface ESMF_GridCreateCubedSphere
! !PRIVATE MEMBER FUNCTIONS:
!
module procedure ESMF_GridCreateCubedSphereReg
module procedure ESMF_GridCreateCubedSphereIReg
! !DESCRIPTION:
! This interface provides a single entry point for the various
! types of {\tt ESMF\_GridCreateCubedSphere} functions.
!EOPI
end interface
! -------------------------- ESMF-public method -------------------------------
!BOPI
! !IROUTINE: ESMF_GridCreateMosaic -- Generic interface
! !INTERFACE:
interface ESMF_GridCreateMosaic
! !PRIVATE MEMBER FUNCTIONS:
!
module procedure ESMF_GridCreateMosaicReg
module procedure ESMF_GridCreateMosaicIReg
! !DESCRIPTION:
! This interface provides a single entry point for the various
! types of {\tt ESMF\_GridCreateMosaic} functions.
!EOPI
end interface
! -------------------------- ESMF-public method -------------------------------
!BOPI
! !IROUTINE: ESMF_GridGet -- Get information from a Grid
! !INTERFACE:
interface ESMF_GridGet
! !PRIVATE MEMBER FUNCTIONS:
!
module procedure ESMF_GridGetDefault
module procedure ESMF_GridGetPLocalDePSloc
module procedure ESMF_GridGetPSloc
module procedure ESMF_GridGetPLocalDe
module procedure ESMF_GridGetPSlocPTile
! !DESCRIPTION:
! This interface provides a single entry point for the various
! types of {\tt ESMF\_GridGet} functions.
!EOPI
end interface
! -------------------------- ESMF-public method -------------------------------
!BOPI
! !IROUTINE: ESMF_GridGetCoord -- Generic interface
! !INTERFACE:
interface ESMF_GridGetCoord
! !PRIVATE MEMBER FUNCTIONS:
!
module procedure ESMF_GridGetCoord1DR4
module procedure ESMF_GridGetCoord2DR4
module procedure ESMF_GridGetCoord3DR4
module procedure ESMF_GridGetCoord1DR8
module procedure ESMF_GridGetCoord2DR8
module procedure ESMF_GridGetCoord3DR8
module procedure ESMF_GridGetCoordIntoArray
module procedure ESMF_GridGetCoordR8
module procedure ESMF_GridGetCoordR4
module procedure ESMF_GridGetCoordInfo
! !DESCRIPTION:
! This interface provides a single entry point for the various
! types of {\tt ESMF\_GridGetCoord} functions.
!EOPI
end interface
! -------------------------- ESMF-public method -------------------------------
!BOPI
! !IROUTINE: ESMF_GridGetItem -- Generic interface
! !INTERFACE:
interface ESMF_GridGetItem
! !PRIVATE MEMBER FUNCTIONS:
!
module procedure ESMF_GridGetItem1DI4
module procedure ESMF_GridGetItem2DI4
module procedure ESMF_GridGetItem3DI4
module procedure ESMF_GridGetItem1DR4
module procedure ESMF_GridGetItem2DR4
module procedure ESMF_GridGetItem3DR4
module procedure ESMF_GridGetItem1DR8
module procedure ESMF_GridGetItem2DR8
module procedure ESMF_GridGetItem3DR8
module procedure ESMF_GridGetItemIntoArray
module procedure ESMF_GridGetItemInfo
! !DESCRIPTION:
! This interface provides a single entry point for the various
! types of {\tt ESMF\_GridGetItem} functions.
!EOPI
end interface
#if 0
! -------------------------- ESMF-public method -------------------------------
!TODO: Temporary until I work out the proper overloading
!BOPI
! !IROUTINE: ESMF_GridGetIndCoord -- Generic interface
! !INTERFACE:
interface ESMF_GridGetCoordInd
! !PRIVATE MEMBER FUNCTIONS:
!
module procedure ESMF_GridGetCoordR4
module procedure ESMF_GridGetCoordR8
! !DESCRIPTION:
! This interface provides a single entry point for the various
! types of {\tt ESMF\_GridGetIndCoord} functions.
!EOPI
end interface
#endif
! -------------------------- ESMF-public method -------------------------------
!BOPI
! !IROUTINE: ESMF_GridSet -- Generic interface
! !INTERFACE:
interface ESMF_GridSet
! !PRIVATE MEMBER FUNCTIONS:
!
module procedure ESMF_GridSetFromDistGrid
! !DESCRIPTION:
! This interface provides a single entry point for the various
! types of {\tt ESMF\_GridSet} functions.
!EOPI
end interface
! -------------------------- ESMF-public method -------------------------------
!BOPI
! !IROUTINE: ESMF_GridSetCoord -- Generic interface
! !INTERFACE:
interface ESMF_GridSetCoord
! !PRIVATE MEMBER FUNCTIONS:
!
module procedure ESMF_GridSetCoordFromArray
! !DESCRIPTION:
! This interface provides a single entry point for the various
! types of {\tt ESMF\_GridSetCoord} functions.
!EOPI
end interface
! -------------------------- ESMF-public method -------------------------------
!BOPI
! !IROUTINE: ESMF_GridSetItem -- Generic interface
! !INTERFACE:
interface ESMF_GridSetItem
! !PRIVATE MEMBER FUNCTIONS:
!
module procedure ESMF_GridSetItemFromArray
! !DESCRIPTION:
! This interface provides a single entry point for the various
! types of {\tt ESMF\_GridSetItem} functions.
!EOPI
end interface
! -------------------------- ESMF-public method -------------------------------
!BOPI
! !IROUTINE: ESMF_GridSetCommitShapeTile -- Generic interface
! !INTERFACE:
interface ESMF_GridSetCommitShapeTile
! !PRIVATE MEMBER FUNCTIONS:
!
module procedure ESMF_GridSetCmmitShapeTileReg
module procedure ESMF_GridSetCmmitShapeTileIrreg
module procedure ESMF_GridSetCmmitShapeTileArb
! !DESCRIPTION:
! This interface provides a single entry point for the various
! types of {\tt ESMF\_GridSetCommitShapeTile} functions.
!EOPI
end interface
!==============================================================================
!BOPI
! !INTERFACE:
interface assignment (=)
! !PRIVATE MEMBER FUNCTIONS:
module procedure ESMF_GridStatusAssignment
module procedure ESMF_GridItemAssignment
! !DESCRIPTION:
! This interface overloads the assignment operator for ESMF_GridStatus_Flag
! It also overloads to assign a string value to an ESMF_GridItem_Flag
!
!EOPI
end interface
!
!------------------------------------------------------------------------------
!BOPI
! !INTERFACE:
interface operator (==)
! !PRIVATE MEMBER FUNCTIONS:
module procedure ESMF_GridConnEqual
! !DESCRIPTION:
! This interface overloads the equality operator for the specific
! ESMF GridConn. It is provided for easy comparisons of
! these types with defined values.
!
!EOPI
end interface
!
!------------------------------------------------------------------------------
!BOPI
! !INTERFACE:
interface operator (/=)
! !PRIVATE MEMBER FUNCTIONS:
module procedure ESMF_GridConnNotEqual
! !DESCRIPTION:
! This interface overloads the inequality operator for the specific
! ESMF GridConn. It is provided for easy comparisons of
! these types with defined values.
!
!EOPI
end interface
!!==============================================================================
!BOPI
! !INTERFACE:
interface operator (==)
! !PRIVATE MEMBER FUNCTIONS:
module procedure ESMF_GridDecompEqual
! !DESCRIPTION:
! This interface overloads the equality operator for the specific
! ESMF_GridDecompType. It is provided for easy comparisons of
! these types with defined values.
!
!EOPI
end interface
!
!------------------------------------------------------------------------------
!BOPI
! !INTERFACE:
interface operator (/=)
! !PRIVATE MEMBER FUNCTIONS:
module procedure ESMF_GridDecompNotEqual
! !DESCRIPTION:
! This interface overloads the inequality operator for the specific
! ESMF_GridDecompType. It is provided for easy comparisons of
! these types with defined values.
!
!EOPI
end interface
!------------------------------------------------------------------------------
!BOPI
! !INTERFACE:
interface operator (==)
! !PRIVATE MEMBER FUNCTIONS:
module procedure ESMF_GridStatusEqual
! !DESCRIPTION:
! This interface overloads the equality operator for the specific
! ESMF GridStatus. It is provided for easy comparisons of
! these types with defined values.
!
!EOPI
end interface
!
!------------------------------------------------------------------------------
!BOPI
! !INTERFACE:
interface operator (/=)
! !PRIVATE MEMBER FUNCTIONS:
module procedure ESMF_GridStatusNotEqual
! !DESCRIPTION:
! This interface overloads the inequality operator for the specific
! ESMF GridStatus. It is provided for easy comparisons of
! these types with defined values.
!
!EOPI
end interface
!------------------------------------------------------------------------------
!BOPI
! !INTERFACE:
interface operator (>)
! !PRIVATE MEMBER FUNCTIONS:
module procedure ESMF_GridStatusGreater
! !DESCRIPTION:
! This interface overloads the inequality operator for the specific
! ESMF GridStatus. It is provided for easy comparisons of
! these types with defined values.
!
!EOPI
end interface
!------------------------------------------------------------------------------
!BOPI
! !INTERFACE:
interface operator (.lt.)
! !PRIVATE MEMBER FUNCTIONS:
module procedure ESMF_GridStatusLess
! !DESCRIPTION:
! This interface overloads the inequality operator for the specific
! ESMF GridStatus. It is provided for easy comparisons of
! these types with defined values.
!
!EOPI
end interface
!------------------------------------------------------------------------------
!BOPI
! !INTERFACE:
interface operator (>=)
! !PRIVATE MEMBER FUNCTIONS:
module procedure ESMF_GridStatusGreaterEqual
! !DESCRIPTION:
! This interface overloads the inequality operator for the specific
! ESMF GridStatus. It is provided for easy comparisons of
! these types with defined values.
!
!EOPI
end interface
!------------------------------------------------------------------------------
!BOPI
! !INTERFACE:
interface operator (.le.)
! !PRIVATE MEMBER FUNCTIONS:
module procedure ESMF_GridStatusLessEqual
! !DESCRIPTION:
! This interface overloads the inequality operator for the specific
! ESMF GridStatus. It is provided for easy comparisons of
! these types with defined values.
!
!EOPI
end interface
!
!==============================================================================
!PoleType
!------------------------------------------------------------------------------
!BOPI
! !INTERFACE:
interface operator (==)
! !PRIVATE MEMBER FUNCTIONS:
module procedure ESMF_PoleTypeEqual
! !DESCRIPTION:
! This interface overloads the equality operator for the specific
! ESMF PoleType. It is provided for easy comparisons of
! these types with defined values.
!
!EOPI
end interface
!
!------------------------------------------------------------------------------
!BOPI
! !INTERFACE:
interface operator (/=)
! !PRIVATE MEMBER FUNCTIONS:
module procedure ESMF_PoleTypeNotEqual
! !DESCRIPTION:
! This interface overloads the inequality operator for the specific
! ESMF PoleType. It is provided for easy comparisons of
! these types with defined values.
!
!EOPI
end interface
!GRIDMATCH
!------------------------------------------------------------------------------
!BOPI
! !INTERFACE:
interface operator (==)
! !PRIVATE MEMBER FUNCTIONS:
module procedure ESMF_GridMatchEqual
! !DESCRIPTION:
! This interface overloads the equality operator for the specific
! ESMF GridMatch. It is provided for easy comparisons of
! these types with defined values.
!
!EOPI
end interface
!
!------------------------------------------------------------------------------
!BOPI
! !INTERFACE:
interface operator (/=)
! !PRIVATE MEMBER FUNCTIONS:
module procedure ESMF_GridMatchNotEqual
! !DESCRIPTION:
! This interface overloads the inequality operator for the specific
! ESMF GridMatch. It is provided for easy comparisons of
! these types with defined values.
!
!EOPI
end interface
!------------------------------------------------------------------------------
!BOPI
! !INTERFACE:
interface operator (>)
! !PRIVATE MEMBER FUNCTIONS:
module procedure ESMF_GridMatchGreater
! !DESCRIPTION:
! This interface overloads the inequality operator for the specific
! ESMF GridMatch. It is provided for easy comparisons of
! these types with defined values.
!
!EOPI
end interface
!------------------------------------------------------------------------------
!BOPI
! !INTERFACE:
interface operator (.lt.)
! !PRIVATE MEMBER FUNCTIONS:
module procedure ESMF_GridMatchLess
! !DESCRIPTION:
! This interface overloads the inequality operator for the specific
! ESMF GridMatch. It is provided for easy comparisons of
! these types with defined values.
!
!EOPI
end interface
!------------------------------------------------------------------------------
!BOPI
! !INTERFACE:
interface operator (>=)
! !PRIVATE MEMBER FUNCTIONS:
module procedure ESMF_GridMatchGreaterEqual
! !DESCRIPTION:
! This interface overloads the inequality operator for the specific
! ESMF GridMatch. It is provided for easy comparisons of
! these types with defined values.
!
!EOPI
end interface
!------------------------------------------------------------------------------
!BOPI
! !INTERFACE:
interface operator (.le.)
! !PRIVATE MEMBER FUNCTIONS:
module procedure ESMF_GridMatchLessEqual
! !DESCRIPTION:
! This interface overloads the inequality operator for the specific
! ESMF GridMatch. It is provided for easy comparisons of
! these types with defined values.
!
!EOPI
end interface
!
!==============================================================================
!===============================================================================
! GridOperator() interfaces
!===============================================================================
! -------------------------- ESMF-public method -------------------------------
!BOP
! !IROUTINE: ESMF_GridAssignment(=) - Grid assignment
!
! !INTERFACE:
! interface assignment(=)
! grid1 = grid2
!
! !ARGUMENTS:
! type(ESMF_Grid) :: grid1
! type(ESMF_Grid) :: grid2
!
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \end{itemize}
!
! !DESCRIPTION:
! Assign grid1 as an alias to the same ESMF Grid object in memory
! as grid2. If grid2 is invalid, then grid1 will be equally invalid after
! the assignment.
!
! The arguments are:
! \begin{description}
! \item[grid1]
! The {\tt ESMF\_Grid} object on the left hand side of the assignment.
! \item[grid2]
! The {\tt ESMF\_Grid} object on the right hand side of the assignment.
! \end{description}
!
!EOP
!------------------------------------------------------------------------------
! -------------------------- ESMF-public method -------------------------------
!BOP
! !IROUTINE: ESMF_GridOperator(==) - Grid equality operator
!
! !INTERFACE:
interface operator(==)
! if (grid1 == grid2) then ... endif
! OR
! result = (grid1 == grid2)
! !RETURN VALUE:
! logical :: result
!
! !ARGUMENTS:
! type(ESMF_Grid), intent(in) :: grid1
! type(ESMF_Grid), intent(in) :: grid2
!
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \end{itemize}
!
! !DESCRIPTION:
! Test whether grid1 and grid2 are valid aliases to the same ESMF
! Grid object in memory. For a more general comparison of two ESMF Grids,
! going beyond the simple alias test, the ESMF\_GridMatch() function
! must be used.
!
! The arguments are:
! \begin{description}
! \item[grid1]
! The {\tt ESMF\_Grid} object on the left hand side of the equality
! operation.
! \item[grid2]
! The {\tt ESMF\_Grid} object on the right hand side of the equality
! operation.
! \end{description}
!
!EOP
module procedure ESMF_GridEQ
end interface
!------------------------------------------------------------------------------
! -------------------------- ESMF-public method -------------------------------
!BOP
! !IROUTINE: ESMF_GridOperator(/=) - Grid not equal operator
!
! !INTERFACE:
interface operator(/=)
! if (grid1 /= grid2) then ... endif
! OR
! result = (grid1 /= grid2)
! !RETURN VALUE:
! logical :: result
!
! !ARGUMENTS:
! type(ESMF_Grid), intent(in) :: grid1
! type(ESMF_Grid), intent(in) :: grid2
!
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \end{itemize}
!
! !DESCRIPTION:
! Test whether grid1 and grid2 are {\it not} valid aliases to the
! same ESMF Grid object in memory. For a more general comparison of two ESMF
! Grids, going beyond the simple alias test, the ESMF\_GridMatch() function
! (not yet fully implemented) must be used.
!
! The arguments are:
! \begin{description}
! \item[grid1]
! The {\tt ESMF\_Grid} object on the left hand side of the non-equality
! operation.
! \item[grid2]
! The {\tt ESMF\_Grid} object on the right hand side of the non-equality
! operation.
! \end{description}
!
!EOP
module procedure ESMF_GridNE
end interface
!------------------------------------------------------------------------------
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
contains
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!-------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridEQ()"
!BOPI
! !IROUTINE: ESMF_GridEQ - Compare two Grids for equality
!
! !INTERFACE:
impure elemental function ESMF_GridEQ(grid1, grid2)
!
! !RETURN VALUE:
logical :: ESMF_GridEQ
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid1
type(ESMF_Grid), intent(in) :: grid2
! !DESCRIPTION:
! Test if both {\tt grid1} and {\tt grid2} alias the same ESMF Grid
! object.
!
!EOPI
!-------------------------------------------------------------------------------
ESMF_INIT_TYPE ginit1, ginit2
integer :: localrc1, localrc2
logical :: lval1, lval2
! Use the following logic, rather than "ESMF-INIT-CHECK-DEEP", to gain
! init checks on both args, and in the case where both are uninitialized,
! to distinguish equality based on uninitialized type (uncreated,
! deleted).
! TODO: Consider moving this logic to C++: use Base class? status?
! Or replicate logic for C interface also.
! check inputs
ginit1 = ESMF_GridGetInit(grid1)
ginit2 = ESMF_GridGetInit(grid2)
! TODO: this line must remain split in two for SunOS f90 8.3 127000-03
if (ginit1 == ESMF_INIT_CREATED .and. &
ginit2 == ESMF_INIT_CREATED) then
ESMF_GridEQ = grid1%this == grid2%this
else
ESMF_GridEQ = ESMF_FALSE
endif
end function ESMF_GridEQ
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridNE()"
!BOPI
! !IROUTINE: ESMF_GridNE - Compare two Grids for non-equality
!
! !INTERFACE:
impure elemental function ESMF_GridNE(grid1, grid2)
!
! !RETURN VALUE:
logical :: ESMF_GridNE
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid1
type(ESMF_Grid), intent(in) :: grid2
! !DESCRIPTION:
! Test if both {\tt grid1} and {\tt grid2} alias the same ESMF Grid
! object.
!
!EOPI
!-------------------------------------------------------------------------------
ESMF_INIT_TYPE ginit1, ginit2
integer :: localrc1, localrc2
logical :: lval1, lval2
! Use the following logic, rather than "ESMF-INIT-CHECK-DEEP", to gain
! init checks on both args, and in the case where both are uninitialized,
! to distinguish equality based on uninitialized type (uncreated,
! deleted).
ESMF_GridNE = .not.ESMF_GridEQ(grid1, grid2)
end function ESMF_GridNE
!-------------------------------------------------------------------------------
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridAddCoord"
!BOP
! !IROUTINE: ESMF_GridAddCoord - Allocate coordinate arrays but don't set their values
! !INTERFACE:
! Private name; call using ESMF_GridAddCoord()
subroutine ESMF_GridAddCoordNoValues(grid, keywordEnforcer, staggerloc, &
staggerEdgeLWidth, staggerEdgeUWidth, staggerAlign, &
staggerLBound,rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
integer, intent(in), optional :: staggerEdgeLWidth(:)
integer, intent(in), optional :: staggerEdgeUWidth(:)
integer, intent(in), optional :: staggerAlign(:)
integer, intent(in), optional :: staggerLBound(:)
integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \end{itemize}
!
! !DESCRIPTION:
!
! When a Grid is created all of its potential stagger locations can hold coordinate
! data, but none of them have storage allocated. This call allocates coordinate
! storage (creates internal ESMF\_Arrays and associated memory) for a particular
! stagger location. Note that this
! call doesn't assign any values to the storage, it only allocates it. The
! remaining options {\tt staggerEdgeLWidth}, etc. allow the user to adjust the
! padding on the coordinate arrays.
!
! The arguments are:
! \begin{description}
! \item[grid]
! Grid to allocate coordinate storage in.
! \item[{[staggerloc]}]
! The stagger location to add. Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! \item[{[staggerEdgeLWidth]}]
! This array should be the same dimCount as the grid. It specifies the lower corner of the stagger
! region with respect to the lower corner of the exclusive region.
! \item[{[staggerEdgeUWidth]}]
! This array should be the same dimCount as the grid. It specifies the upper corner of the stagger
! region with respect to the upper corner of the exclusive region.
! \item[{[staggerAlign]}]
! This array is of size grid dimCount.
! For this stagger location, it specifies which element
! has the same index value as the center. For example,
! for a 2D cell with corner stagger it specifies which
! of the 4 corners has the same index as the center.
! If this is set and either staggerEdgeUWidth or staggerEdgeLWidth is not,
! this determines the default array padding for a stagger.
! If not set, then this defaults to all negative. (e.g.
! The most negative part of the stagger in a cell is aligned with the
! center and the padding is all on the positive side.)
! \item[{[staggerLBound]}]
! Specifies the lower index range of the memory of every DE in this staggerloc in this Grid.
! Only used when Grid indexflag is {\tt ESMF\_INDEX\_USER}.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
integer :: tmp_staggerloc
integer :: localrc ! local error status
type(ESMF_GridDecompType) :: decompType ! Arbitrary or not
type(ESMF_InterArray) :: staggerEdgeLWidthArg ! Language Interface Helper Var
type(ESMF_InterArray) :: staggerEdgeUWidthArg ! Language Interface Helper Var
type(ESMF_InterArray) :: staggerAlignArg ! Language Interface Helper Var
type(ESMF_InterArray) :: staggerLBoundArg ! Language Interface Helper Var
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check init status of arguments
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, grid, rc)
! Get Grid decomposition type
call ESMF_GridGetDecompType(grid, decompType, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! handle staggerloc
if (present(staggerloc)) then
if ((decompType == ESMF_GRID_ARBITRARY) .and. &
(staggerloc /= ESMF_STAGGERLOC_CENTER)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- staggerloc has to be ESMF_STAGGERLOC_CENTER for arbitrary grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
else
tmp_staggerloc=staggerloc%staggerloc
endif
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc
endif
if (decompType == ESMF_GRID_ARBITRARY) then
if (present(staggerEdgeLWidth) .or. present(staggerEdgeUWidth) .or. &
present(staggerAlign)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- stagger arguments should not be set for arbitrary grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
else
! Call C++ Subroutine to do the create
call c_ESMC_gridaddcoordarb(grid%this,tmp_staggerloc, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
else
!! staggerEdgeLWidth
staggerEdgeLWidthArg = ESMF_InterArrayCreate(staggerEdgeLWidth, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! staggerEdgeUWidth
staggerEdgeUWidthArg = ESMF_InterArrayCreate(staggerEdgeUWidth, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! staggerAlign
staggerAlignArg = ESMF_InterArrayCreate(staggerAlign, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! staggerMemLBound
staggerLBoundArg = ESMF_InterArrayCreate(staggerLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Call C++ Subroutine to do the create
call c_ESMC_gridaddcoord(grid%this,tmp_staggerloc, &
staggerEdgeLWidthArg, staggerEdgeUWidthArg, staggerAlignArg, staggerLBoundArg, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate helper variables
call ESMF_InterArrayDestroy(staggerEdgeLWidthArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(staggerEdgeUWidthArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(staggerAlignArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(staggerLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridAddCoordNoValues
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridAddCoord"
!BOPI
! !IROUTINE: ESMF_GridAddCoord - Set coordinates using an array of Arrays
! !INTERFACE:
! Private name; call using ESMF_GridAddCoord()
subroutine ESMF_GridAddCoordArrayList(grid, staggerloc, &
arrayList, datacopyflag, staggerEdgeLWidth, &
staggerEdgeUWidth, staggerAlign, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
type(ESMF_Array), intent(in) :: arrayList(:)
type(ESMF_DataCopy_Flag), intent(in), optional :: datacopyflag ! NOT IMPLEMENTED
integer, intent(in), optional :: staggerEdgeLWidth(:)
integer, intent(in), optional :: staggerEdgeUWidth(:)
integer, intent(in), optional :: staggerAlign(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This method sets the passed in Array as the holder of the coordinate data
! for stagger location {\tt staggerloc} and coordinate {\tt coord}. If the location
! already contains an Array, then this one overwrites it.
!
! The arguments are:
!\begin{description}
!\item[{staggerloc}]
! The stagger location into which to copy the arrays.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
!\item[{arrayList}]
! An array to set the grid coordinate information from.
!\item[{[datacopyflag]}]
! If not specified, default to {\tt ESMF\_DATACOPY\_REFERENCE}, in this case the Grid
! coordinate Array will be set to a reference to {\tt array}. Please see
! Section~\ref{const:datacopyflag} for further description and a list of
! valid values.
! [THE ESMF\_DATACOPY\_VALUE OPTION IS CURRENTLY NOT IMPLEMENTED]
! \item[{[staggerEdgeLWidth]}]
! This array should be the same rank as the grid. It specifies the lower corner of the stagger
! region with respect to the lower corner of the exclusive region.
! \item[{[staggerEdgeUWidth]}]
! This array should be the same rank as the grid. It specifies the upper corner of the stagger
! region with respect to the upper corner of the exclusive region.
! \item[{[staggerAlign]}]
! This array is of size grid rank.
! For this stagger location, it specifies which element
! has the same index value as the center. For example,
! for a 2D cell with corner stagger it specifies which
! of the 4 corners has the same index as the center.
! If this is set and either staggerEdgeUWidth or staggerEdgeLWidth is not,
! this determines the default array padding for a stagger.
! If not set, then this defaults to all negative. (e.g.
! The most negative part of the stagger in a cell is aligned with the
! center and the padding is all on the positive side.)
!\item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
!\end{description}
!
!EOPI
integer :: tmp_staggerloc
integer :: localrc ! local error status
type(ESMF_InterArray) :: staggerEdgeLWidthArg ! Language Interface Helper Var
type(ESMF_InterArray) :: staggerEdgeUWidthArg ! Language Interface Helper Var
type(ESMF_InterArray) :: staggerAlignArg ! Language Interface Helper Var
integer :: i,arrayCount
type(ESMF_Pointer), allocatable :: arrayPointerList(:) ! helper variable
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Get size of array list
arrayCount=size(arrayList)
! Check init status of arguments
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, grid, rc)
do i=1, arrayCount
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_ArrayGetInit, arrayList(i), rc)
enddo
! handle staggerloc
if (present(staggerloc)) then
tmp_staggerloc=staggerloc%staggerloc
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc
endif
!! staggerLWidth
staggerEdgeLWidthArg = ESMF_InterArrayCreate(staggerEdgeLWidth, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! staggerEdgeUWidth
staggerEdgeUWidthArg = ESMF_InterArrayCreate(staggerEdgeUWidth, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! staggeAlign
staggerAlignArg = ESMF_InterArrayCreate(staggerAlign, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! staggerAlign
staggerAlignArg = ESMF_InterArrayCreate(staggerAlign, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Copy C++ pointers of deep objects into a simple ESMF_Pointer array
! This is necessary in order to strip off the F90 init check members
! when passing into C++
allocate(arrayPointerList(arrayCount))
do i=1, arrayCount
call ESMF_ArrayGetThis(arrayList(i), arrayPointerList(i), localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
! Call C++ Subroutine to do the create
call c_ESMC_gridaddcoordarraylist(grid%this,tmp_staggerloc, &
arrayCount, arrayPointerList, datacopyflag, staggerEdgeLWidthArg, &
staggerEdgeUWidthArg, staggerAlignArg, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! cleanup
deallocate(arrayPointerList)
call ESMF_InterArrayDestroy(staggerEdgeLWidthArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(staggerEdgeUWidthArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(staggerAlignArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridAddCoordArrayList
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridAddItem"
!BOP
! !IROUTINE: ESMF_GridAddItem - Allocate item array but don't set their values
! !INTERFACE:
! Private name; call using ESMF_GridAddItem()
subroutine ESMF_GridAddItemNoValues(grid, itemflag, &
keywordEnforcer, staggerloc, itemTypeKind, staggerEdgeLWidth, staggerEdgeUWidth, &
staggerAlign, staggerLBound,rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type (ESMF_GridItem_Flag),intent(in) :: itemflag
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type (ESMF_StaggerLoc) , intent(in), optional :: staggerloc
type (ESMF_TypeKind_Flag),intent(in), optional :: itemTypeKind
integer, intent(in), optional :: staggerEdgeLWidth(:)
integer, intent(in), optional :: staggerEdgeUWidth(:)
integer, intent(in), optional :: staggerAlign(:)
integer, intent(in), optional :: staggerLBound(:)
integer, intent(out),optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \end{itemize}
!
! !DESCRIPTION:
!
! When a Grid is created all of its potential stagger locations can hold item
! data, but none of them have storage allocated. This call allocates item
! storage (creates an internal ESMF\_Array and associated memory) for a particular
! stagger location. Note that this
! call doesn't assign any values to the storage, it only allocates it. The
! remaining options {\tt staggerEdgeLWidth}, etc. allow the user to adjust the
! padding on the item array.
!
! The arguments are:
! \begin{description}
! \item[grid]
! Grid to allocate coordinate storage in.
! \item[itemflag]
! The grid item to add. Please see Section~\ref{const:griditem} for a list of valid items.
! \item[{[staggerloc]}]
! The stagger location to add. Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! \item[{[itemTypeKind]}]
! The typekind of the item to add.
! \item[{[staggerEdgeLWidth]}]
! This array should be the same dimCount as the grid. It specifies the lower corner of the stagger
! region with respect to the lower corner of the exclusive region.
! \item[{[staggerEdgeUWidth]}]
! This array should be the same dimCount as the grid. It specifies the upper corner of the stagger
! region with respect to the upper corner of the exclusive region.
! \item[{[staggerAlign]}]
! This array is of size grid dimCount.
! For this stagger location, it specifies which element
! has the same index value as the center. For example,
! for a 2D cell with corner stagger it specifies which
! of the 4 corners has the same index as the center.
! If this is set and either staggerEdgeUWidth or staggerEdgeLWidth is not,
! this determines the default array padding for a stagger.
! If not set, then this defaults to all negative. (e.g.
! The most negative part of the stagger in a cell is aligned with the
! center and the padding is all on the positive side.)
! \item[{[staggerLBound]}]
! Specifies the lower index range of the memory of every DE in this staggerloc in this Grid.
! Only used when Grid indexflag is {\tt ESMF\_INDEX\_USER}.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
integer :: tmp_staggerloc
integer :: localrc ! local error status
type(ESMF_InterArray) :: staggerEdgeLWidthArg ! Language Interface Helper Var
type(ESMF_InterArray) :: staggerEdgeUWidthArg ! Language Interface Helper Var
type(ESMF_InterArray) :: staggerAlignArg ! Language Interface Helper Var
type(ESMF_InterArray) :: staggerLBoundArg ! Language Interface Helper Var
type(ESMF_GridDecompType) :: decompType ! decompose type: arbitrary or non-arbitrary
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check init status of arguments
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, grid, rc)
! Get Grid decomposition type
call ESMF_GridGetDecompType(grid, decompType, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! handle staggerloc
if (present(staggerloc)) then
tmp_staggerloc=staggerloc%staggerloc
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc
endif
! Check if the grid is arbitrary
if (decompType == ESMF_GRID_ARBITRARY) then
if (present(staggerEdgeLWidth) .or. present(staggerEdgeUWidth)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- staggerEdgeLWidth and staggerEdigeUWidth are not allowed for arbitrary grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (present(staggerAlign)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- staggerAlign is not allowed for arbitrarily distributed grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (present(staggerloc)) then
if (staggerloc /= ESMF_STAGGERLOC_CENTER) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- staggerloc has to be ESMF_STAGGERLOC_CENTER for arbitrary grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! Call C++ Subroutine to do the create
call c_ESMC_gridadditemarb(grid%this,tmp_staggerloc, itemflag, itemTypeKind, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
!! staggerEdgeLWidth
staggerEdgeLWidthArg = ESMF_InterArrayCreate(staggerEdgeLWidth, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! staggerEdgeUWidth
staggerEdgeUWidthArg = ESMF_InterArrayCreate(staggerEdgeUWidth, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! staggerAlign
staggerAlignArg = ESMF_InterArrayCreate(staggerAlign, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! staggerLBound
staggerLBoundArg = ESMF_InterArrayCreate(staggerLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Call C++ Subroutine to do the create
call c_ESMC_gridadditem(grid%this,tmp_staggerloc, itemflag, itemTypeKind, &
staggerEdgeLWidthArg, staggerEdgeUWidthArg, staggerAlignArg, &
staggerLBoundArg, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate helper variables
call ESMF_InterArrayDestroy(staggerEdgeLWidthArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(staggerEdgeUWidthArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(staggerAlignArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(staggerLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridAddItemNoValues
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCommit"
!BOPI
! !IROUTINE: ESMF_GridCommit - Commit a Grid to a specified completion level
! !INTERFACE:
subroutine ESMF_GridCommit(grid, status, defaultflag, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(inout) :: grid
type(ESMF_GridStatus_Flag), optional :: status ! NOT IMPLEMENTED
type(ESMF_DefaultFlag), optional :: defaultflag ! NOT IMPLEMENTED
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This call is used to complete the {\tt grid} so that it is usable at
! the level indicated by the {\tt status} flag. For example, once committed
! with a {\tt status} value of {\tt ESMF\_GRIDSTATUS\_SHAPE\_READY}, the
! {\tt grid} will have sufficient size, dimCount, and distribution information to be
! used as the basis for allocating Field data. (The integration of
! Field and Grid classes has't yet happened, so you can't currently
! allocate Fields based on Grids no matter what the status.)
!
! It is necessary to call the {\tt ESMF\_GridCommit()} method after
! creating a Grid object using the {\tt ESMF\_GridEmptyCreate()} method
! and incrementally filling it in with {\tt ESMF\_GridSet()} calls. The
! {\tt EMF\_GridCommit()} call is a signal to the Grid that it can combine
! the pieces of information that it's received and finish building any
! necessary internal structures. For example, an {\tt ESMF\_GridCommit()}
! call with the {\tt status} flag set to
! {\tt ESMF\_GRIDSTATUS\_SHAPE\_READY} will trigger the {\tt grid} to
! build an internal DistGrid object that contains topology and distribution
! information.
!
! It's possible using the {\tt ESMF\_GridEmptyCreate()/ESMF\_GridSet()}
! approach that not all information is present when the {\tt ESMF\_GridCommit}
! call is made. If this is the case and the {\tt defaultflag} is set to
! {\tt ESMF\_USE\_DEFAULTS} the Grid will attempt to build any internal
! objects necessary to get to the desired {\tt status} by using reasonable
! defaults. If the {\tt defaultflag} is set to {\tt ESMF\_NO\_DEFAULTS} and
! any information is missing, the {\tt ESMF\_GridCommit} call will fail.
! If the {\tt defaultflag} argument is not passed in, {\it no} defaults
! are used.
!
! The arguments are:
! \begin{description}
! \item[{grid}]
! Grid object to commit.
! \item[{status}]
! Grid status to commit to. For valid values see section
! \ref{const:gridstatus}. [CURRENTLY NOT IMPLEMENTED]
! \item[{[defaultFlag]}]
! Indicates whether to use default values to achieve the desired
! grid status. The default value is {\tt ESMF\_NO\_DEFAULTS}.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
integer :: localrc ! local error status
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check init status of arguments
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, grid, rc)
! Check for Not Implemented options
if (present(status)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- status not yet implemented", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (present(defaultflag)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- defaultflag not yet implemented", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Call C++ Subroutine to do the create
call c_ESMC_gridcommit(grid%this, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridCommit
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "GridConvertIndex"
!BOPI
! !IROUTINE: ESMF_GridConvertIndex - Convert Arbitrary Grid index into DistGrid index
! !INTERFACE:
subroutine ESMF_GridConvertIndex(grid,gridindex, distgridindex, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
integer , intent(in) :: gridindex(:)
integer , intent(out) :: distgridindex(:)
integer , intent(out), optional :: rc
!
! !DESCRIPTION:
!
! Convert a multi-dimensional index of the arbitrarily distributed grid into the
! index of the 1D DistGrid. The associated DistGrid for an arbitrarily distributed
! grid is 1D plus any undistributed dimension. The function
! calculates the index of the DistGrid for a given index from the original Grid.
!
! The arguments are:
! \begin{description}
! \item[{grid}]
! The grid to get the information from to create the Array.
! \item[{[gridindex]}]
! The Grid index to be converted.
! \item[{[distgridindex]}]
! The DistGrid index to be returned.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
!\end{description}
!
!EOPI
integer :: localrc
integer :: DimCount, distDimCount, undistDimCount
integer, pointer :: minIndex(:)
integer, pointer :: maxIndex(:)
integer, pointer :: distgridToGridMap(:)
integer :: i,j,k
integer :: index1D ! the return value
type(ESMF_InterArray) :: gridIndexArg
type(ESMF_GridDecompType) :: decompType
type(ESMF_DistGrid) :: distGrid
integer, allocatable :: undistdim(:)
logical :: found
integer :: distGridDimCount, arbDim
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check init status of arguments
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, grid, rc)
! Get Grid decomposition type
call ESMF_GridGetDecompType(grid, decompType, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Check if the grid is arbitrary
if (decompType /= ESMF_GRID_ARBITRARY) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- ESMF_GridConvertIndex only works for arbritrarily distributed grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Get info from Grid
call ESMF_GridGet(grid, distgrid= distGrid, DimCount=DimCount, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! allocate minIndex and maxIndex
allocate(minIndex(DimCount), maxIndex(DimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndex and maxIndex", &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get minIndex and maxIndex from the grid
call ESMF_GridGetIndex(grid, minIndex= minIndex, maxIndex=maxIndex, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! find out how many dimensions are arbitrarily distributed
call ESMF_DistGridGet(distGrid, dimcount = distGridDimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (distGridDimCount > dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- distgrid dimension has to be less than or equal to dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! set distDimCount - number of dimensions arbitrarily distributed
! undistDimCount - number of dimensions not arbitrarily distributed
if (distGridDimCount == 1) then
! all dimensions are arbitrarily distributed
distDimCount = dimCount
undistDimCount = 0
else
undistDimCount = distGridDimCount - 1
distDimCount = dimCount - undistDimCount
endif
! Check index dimension
if (size(gridindex) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- gridindex dimension is different from the grid DimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Check index out of bound
do i=1,dimCount
if (gridindex(i) .lt. minIndex(i) .and. gridindex(i) > maxIndex(i)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- gridindex is out of bound", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
enddo
! clean up memory allocation
deallocate(minIndex)
deallocate(maxIndex)
! Call the C function to get the index of the 1D distgrid
!! index
gridIndexArg = ESMF_InterArrayCreate(gridindex, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call c_ESMC_gridconvertindex(grid%this, gridIndexArg, index1D, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (undistDimCount /= 0) then
allocate(distgridToGridMap(dimCount), stat=localrc)
call ESMF_GridGet(grid, arbDim=arbDim, &
distgridToGridMap=distgridToGridMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
allocate(undistdim(undistDimCount))
do i=1,dimCount
found = .false.
do j=1,distDimCount
if (i == distgridToGridMap(j)) found=.true.
enddo
if (.not. found) then
undistdim(k)=i
k=k+1
endif
enddo
k=1
do i=1,distGridDimCount
if (i == arbDim) then
distgridindex(i)=index1D
else
distgridindex(i)=gridindex(undistdim(k))
k=k+1
endif
enddo
deallocate(undistdim)
deallocate(distgridToGridMap)
else
distgridindex(1)=index1D
endif
! clean up memory allocation
call ESMF_InterArrayDestroy(GridIndexArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
return
end subroutine ESMF_GridConvertIndex
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ArrayCreateFromGrid"
!BOPI
! !IROUTINE: ESMF_ArrayCreateFromGrid - Create an Array to hold data for a stagger location
! !INTERFACE:
function ESMF_ArrayCreateFromGrid(grid,staggerloc, typekind, &
gridToArrayMap, ungriddedLBound, ungriddedUBound, &
totalLWidth, totalUWidth, name, rc)
!
! !RETURN VALUE:
type(ESMF_Array) :: ESMF_ArrayCreateFromGrid
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type(ESMF_StaggerLoc), intent(in), optional :: staggerloc
type(ESMF_TypeKind_Flag), intent(in), optional :: typekind
integer, intent(in), optional :: gridToArrayMap(:)
integer, intent(in), optional :: ungriddedLBound(:)
integer, intent(in), optional :: ungriddedUBound(:)
integer, intent(in), optional :: totalLWidth(:)
integer, intent(in), optional :: totalUWidth(:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! Create an ESMF Array which is suitable to hold data for a particular
! stagger location in a Grid. The Array will have the correct bounds, distgridToGridMap,
! distgrid, etc. The {\tt totalWidth} variables can be used to add extra padding
! around the Array (e.g. for use as a halo).
!
! The arguments are:
! \begin{description}
!\item[{grid}]
! The grid to get the information from to create the Array.
!\item[{staggerloc}]
! The stagger location to build the Array for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
! \item[{[typekind]}]
! The type/kind of the newly created array data. For a full list of
! options, please see section~\ref{const:typekind}.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
!\item[{[gridToArrayMap]}]
! Indicates where each grid dimension goes in the newly created Array.
! {\tt The array gridToArrayMap} should be at least of size equal to the grid's dimCount.
! If not set defaults to (1,2,3,....). An entry of 0 indicates the grid dimension
! won't be used in the creation of the Array.
!\item[{[ungriddedLBound]}]
! The lower bounds of the non-grid Array dimensions.
!\item[{[ungriddedUBound]}]
! The upper bounds of the non-grid array dimensions.
!\item[{[totalLWidth]}]
! Extra padding to be added to the Array. {\tt totalLWidth} is the amount
! that the lower boundary of the Array should be dropped relative
! to the lower bound of the exclusive region.
!\item[{[totalUWidth]}]
! Extra padding to be added to the Array. {\tt totalUWidth} is the amount
! that the upper boundary of the Array should be raised relative
! to the upper bound of the exclusive region.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
integer :: localrc ! local error status
type(ESMF_Array) :: array
type(ESMF_ArraySpec) :: arrayspec
type(ESMF_DistGrid) :: distgrid
type(ESMF_Index_Flag) :: indexflag
type(ESMF_TypeKind_Flag) :: localTypeKind
type(ESMF_StaggerLoc) :: localStaggerLoc
integer, pointer :: arrayLBound(:),arrayUBound(:)
integer, pointer :: distgridToArrayMap(:)
integer :: dimCount
integer :: i,ungriddedDimCount, arrayDimCount, undistArrayDimCount
logical :: contains_nonzero
integer :: gridUsedDimCount
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check init status of arguments
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, grid, rc)
! Set Default TypeKind if neccessary
if (present(typekind)) then
localTypeKind=typekind
else
localTypeKind=ESMF_TYPEKIND_R8
endif
! Set Default StaggerLoc if neccessary
if (present(staggerloc)) then
localStaggerLoc=staggerloc
else
localStaggerLoc=ESMF_STAGGERLOC_CENTER
endif
! Both the bounds need to be present if either is.
if ((present(ungriddedLBound) .or. present(ungriddedUBound)) .and. &
.not. (present(ungriddedLBound) .and. present(ungriddedUBound))) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- if either ungriddedBound is present both need to be", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! The bounds need to be the same size
if (present(ungriddedLBound) .and. present(ungriddedUBound)) then
if (size(ungriddedLBound) /= size(ungriddedUBound)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- ungriddedLBound and ungriddedUBound must be the same size ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! Get the ungridded dimCount
ungriddedDimCount=0
if (present(ungriddedUBound)) then
ungriddedDimCount=size(ungriddedUBound)
endif
! Get info from Grid
call ESMF_GridGet(grid, dimCount=dimCount, &
indexflag=indexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! calc undist Array DimCount
undistArrayDimCount=ungriddedDimCount
! Make sure gridToArrayMap is correct size
if (present(gridToArrayMap)) then
if (size(gridToArrayMap) < dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridToArrayMap needs to at least be of the Grid's dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! calc the number of dimensions from the grid being used (e.g. with non-zero mapping)
if (present(gridToArrayMap)) then
gridUsedDimCount=0
do i=1,dimCount
if (gridToArrayMap(i) > 0) then
gridUsedDimCount=gridUsedDimCount+1
endif
enddo
else
! Default assumes all grid dims are used so add number of grid dims
gridUsedDimCount=dimCount
endif
! calc full Array DimCount
! Its the ungriddedDimCount + the number of non-zero entries in gridToArrayMap
arrayDimCount=ungriddedDimCount+gridUsedDimCount
! Make sure gridToArrayMap is correct size
if (present(gridToArrayMap)) then
do i=1,dimCount
if ((gridToArrayMap(i) <0) .or. (gridToArrayMap(i) > arrayDimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- gridToArrayMap value is outside range", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
enddo
endif
! Make sure gridToArrayMap contains at least one non-zero entry
if (present(gridToArrayMap)) then
contains_nonzero=.false.
do i=1,dimCount
if (gridToArrayMap(i) >0) then
contains_nonzero=.true.
endif
enddo
if (.not. contains_nonzero) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- gridToArrayMap must contains at least one value greater than 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! construct ArraySpec
call ESMF_ArraySpecSet(arrayspec,rank=arrayDimCount,typekind=localTypeKind, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! allocate distgridToArrayMap
allocate(distgridToArrayMap(dimCount) , stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating distgridToArrayMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
! allocate undistributed Bounds
allocate(arrayLBound(undistArrayDimCount) , stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridLBound", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(arrayUBound(undistArrayDimCount) , stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridUBound", &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get dimmap and undistibuted bounds
call ESMF_GridGetArrayInfo(grid, localstaggerloc, &
gridToArrayMap, ungriddedLBound, ungriddedUBound, &
distgrid, distgridToArrayMap, arrayLBound, arrayUBound, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! create Array
array=ESMF_ArrayCreate(arrayspec=arrayspec, &
distgrid=distgrid, distgridToArrayMap=distgridToArrayMap, &
totalLWidth=totalLWidth, totalUWidth=totalUWidth, &
indexflag=indexflag, &
undistLBound=arrayLBound, undistUBound=arrayUBound, name=name, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set return value
ESMF_ArrayCreateFromGrid = array
! cleanup
deallocate(distgridToArrayMap)
deallocate(arrayLBound)
deallocate(arrayUBound)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_ArrayCreateFromGrid
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetArrayInfo"
!BOPI
! !IROUTINE: ESMF_GridGetArrayInfo - get information to make an Array from a Grid
! !INTERFACE:
subroutine ESMF_GridGetArrayInfo(grid, staggerloc, &
gridToFieldMap, ungriddedLBound, ungriddedUBound, &
staggerDistgrid, distgridToArrayMap, &
undistLBound, undistUBound, &
rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type(ESMF_StaggerLoc), intent(in), optional :: staggerloc
integer, intent(in), optional :: gridToFieldMap(:)
integer, intent(in), optional :: ungriddedLBound(:)
integer, intent(in), optional :: ungriddedUBound(:)
type(ESMF_DistGrid), intent(out), optional :: staggerDistgrid
integer, intent(out) :: distgridToArrayMap(:)
integer, intent(out), optional :: undistLBound(:)
integer, intent(out), optional :: undistUBound(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This subroutine gets information from a Grid which is useful in creating an
! Array corresponding to a Field. This subroutine returns the distgridToArray map and
! undistBounds which can be used to create an Array the same size and shape as the Grid.
! Optionally, the user can pass in non-grid bounds, the subroutine then
! returns a map and undistbounds which include these non-grid bounds.
!
! The arguments are:
! \begin{description}
!\item[{grid}]
! The grid to get the information from to create the Array.
!\item[{staggerloc}]
! The stagger location to build the Array for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
!\item[staggerDistgrid]
! The class that describes the stagger locations in the grids distribution.
!\item[{[gridToFieldMap]}]
! Indicates how the grid dimension map to the field that the newly created array
! is associated with. {\tt The array gridToFieldMap} should be at least of size equal
! to the grid's dimCount. If not set defaults to (1,2,3,....). An entry of 0 indicates
! the grid dimension isn't mapped to the Array.
!\item[{[ungriddedLBound]}]
! The lower bounds of the non-grid Array dimensions.
!\item[{[ungriddedUBound]}]
! The upper bounds of the non-grid array dimensions.
!\item[{distgridToArrayMap}]
! The distgrid to Array dimension map (must be allocated to at least
! the number of dimensions of the distGrid).
!\item[{undistLBound}]
! Undistributed lower bounds (must be of size grid undistDimCount+size(ungriddedUBound))
!\item[{undistUBound}]
! Undistributed upper bounds (must be of size grid undistDimCount+size(ungriddedUBound))
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
integer :: localrc ! local error status
type(ESMF_StaggerLoc) :: localStaggerLoc
type(ESMF_GridDecompType) :: decompType
integer, pointer :: arrayDimType(:)
integer, pointer :: arrayDimInd(:)
integer, pointer :: distgridToGridMap(:)
integer :: dimCount,distDimCount, arrayDimCount
integer :: i,j,k,ungriddedDimCount, undistArrayDimCount, bndpos
integer :: gridComputationalEdgeLWidth(ESMF_MAXDIM)
integer :: gridComputationalEdgeUWidth(ESMF_MAXDIM)
integer :: tmpArrayComputationalEdgeLWidth(ESMF_MAXDIM)
integer :: tmpArrayComputationalEdgeUWidth(ESMF_MAXDIM)
integer :: localGridToFieldMap(ESMF_MAXDIM)
logical :: filled(ESMF_MAXDIM)
logical :: contains_nonzero
integer :: fieldDimCount
integer :: gridUsedDimCount
integer :: arbdim, rep_arb, rep_noarb
logical :: found
type(ESMF_DistGrid) :: distgrid
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check init status of arguments
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, grid, rc)
! Get DecomposeType
call ESMF_GridGetDecompType(grid, decompType, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set Default StaggerLoc if neccessary
if (present(staggerloc)) then
localStaggerLoc=staggerloc
else
localStaggerLoc=ESMF_STAGGERLOC_CENTER
endif
! Both the bounds need to be present if either is.
if ((present(ungriddedLBound) .or. present(ungriddedUBound)) .and. &
.not. (present(ungriddedLBound) .and. present(ungriddedUBound))) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- if either ungriddedBound is present both need to be", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! The bounds need to be the same size
if (present(ungriddedLBound) .and. present(ungriddedUBound)) then
if (size(ungriddedLBound) /= size(ungriddedUBound)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- ungriddedLBound and ungriddedUBound must be the same size ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! Get the ungridded dimCount
ungriddedDimCount=0
if (present(ungriddedUBound)) then
ungriddedDimCount=size(ungriddedUBound)
endif
! Get info from Grid
call ESMF_GridGet(grid, dimCount=dimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! calc undist Array DimCount
undistArrayDimCount=ungriddedDimCount
! Make sure gridToFieldMap is correct size
if (present(gridToFieldMap)) then
if (size(gridToFieldMap) < dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridToFieldMap needs to at least be of the Grid's dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! Get grid distgrid
call ESMF_GridGet(grid, localStaggerLoc, distgrid=distgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! if argument is present, then pass out distgrid
if (present(staggerDistGrid)) then
staggerDistGrid=distgrid
endif
! if the Grid is arbitrary, the array dimension will be different depending on how many
! grid dimensions are arbitrarily distributed
if (decompType == ESMF_GRID_NONARBITRARY) then
! calc the number of dimensions from the grid being used (e.g. with non-zero mapping)
if (present(gridToFieldMap)) then
gridUsedDimCount=0
do i=1,dimCount
if (gridToFieldMap(i) > 0) then
gridUsedDimCount=gridUsedDimCount+1
endif
enddo
else
! Default assumes all grid dims are used so add number of grid dims
gridUsedDimCount=dimCount
endif
! calc full Array DimCount
! Its the ungriddedDimCount + the number of non-zero entries in gridToFieldMap
arrayDimCount=ungriddedDimCount+gridUsedDimCount
! Make sure gridToFieldMap is correct size
if (present(gridToFieldMap)) then
do i=1,dimCount
if ((gridToFieldMap(i) <0) .or. (gridToFieldMap(i) > arrayDimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- gridToFieldMap value is outside range", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
enddo
endif
! Take out the below test to allow Fields that don't have a dim that maps
! to the Grid. Take this code out for good after things have been tested for awhile.
#if 0
! Make sure gridToFieldMap contains at least one non-zero entry
if (present(gridToFieldMap)) then
contains_nonzero=.false.
do i=1,dimCount
if (gridToFieldMap(i) >0) then
contains_nonzero=.true.
endif
enddo
if (.not. contains_nonzero) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- gridToFieldMap must contains at least one value greater than 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
#endif
! Check distgridToArrayMap
if (size(distgridToArrayMap) < dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- distgridToArrayMap is too small", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! set default GridToFieldMap
if (present(gridToFieldMap)) then
localGridToFieldMap(1:dimCount)=gridToFieldMap(1:dimCount)
else
do i=1,dimCount
localGridToFieldMap(i)=i
enddo
endif
! allocate distgridToGridMap
allocate(distgridToGridMap(dimCount) , stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating distgridToGridMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get info from Grid
call ESMF_GridGet(grid, distgridToGridMap=distgridToGridMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! construct distgridToArrayMap
do i=1,dimCount
distgridToArrayMap(i)=localGridToFieldMap(distgridToGridMap(i))
enddo
! construct array based on the presence of distributed dimensions
! if there are undistributed dimensions ...
if (undistArrayDimCount > 0) then
!! allocate array dim. info arrays
allocate(arrayDimType(arrayDimCount) , stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridUBound", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(arrayDimInd(arrayDimCount) , stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridUBound", &
ESMF_CONTEXT, rcToReturn=rc)) return
!! set which dimensions are used by the distgrid
arrayDimType(:)=0 ! initialize to no type
do i=1,dimCount
if (distGridToArrayMap(i) > 0) then ! skip replicated dims
arrayDimType(distGridToArrayMap(i))=1 ! set to distributed
endif
enddo
! TODO: make the below cleaner given no grid undistdim
!! Fill in ungridded bound info
bndpos=1
do i=1,arrayDimCount
if (arrayDimType(i) == 0) then
arrayDimInd(i)=bndpos
arrayDimType(i)=2 ! set to undistributed Array
bndpos=bndpos+1
endif
enddo
!! Finally setup new Array bounds based on info in arrayDimType and arrayDimInd
bndpos=1
do i=1,arrayDimCount
if (arrayDimType(i) == 2) then
if (present (undistLBound)) &
undistLBound(bndpos)=ungriddedLBound(arrayDimInd(i))
if (present (undistUBound)) &
undistUBound(bndpos)=ungriddedUBound(arrayDimInd(i))
bndpos=bndpos+1
endif
enddo
!! cleanup
deallocate(arrayDimType)
deallocate(arrayDimInd)
endif
! cleanup
deallocate(distgridToGridMap)
else
! Code for Arbitrarily Distributed Grid
call ESMF_DistGridGet(distgrid, dimCount=distDimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(gridToFieldMap)) then
gridUsedDimCount=0
do i=1,dimCount
if (gridToFieldMap(i) > 0) then
gridUsedDimCount=gridUsedDimCount+1
endif
enddo
else
! Default assumes all grid dims are used so add number of grid dims
gridUsedDimCount=dimCount
endif
! calc full Array DimCount
! Its the ungriddedDimCount + the number of non-zero entries in gridToFieldMap
fieldDimCount=ungriddedDimCount+gridUsedDimCount
! Make sure gridToFieldMap is correct size
! check for replicated dimension
if (present(gridToFieldMap)) then
do i=1,dimCount
if ((gridToFieldMap(i) <0) .or. (gridToFieldMap(i) > fieldDimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- gridToFieldMap value is outside range", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
enddo
endif
! set default GridToFieldMap
if (present(gridToFieldMap)) then
localGridToFieldMap(1:dimCount)=gridToFieldMap(1:dimCount)
else
do i=1,dimCount
localGridToFieldMap(i)=i
enddo
endif
! If there is replicated dimension, check if they are arbitrarily distributed dimension
! The array dimension varies depends whether the replicated dimensions are arb. or not
allocate(distgridToGridMap(dimCount))
call ESMF_GridGet(grid, distgridToGridMap=distgridToGridMap, &
arbDim=arbdim, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Check distgridToArrayMap
if (size(distgridToArrayMap) < distDimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- distgridToArrayMap is too small", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! count how many replicated dimensions are not arbitrary and if any of replicated dimension
! is arbitrary. Assuming if one arbitrary dim is replicated, all the arbitrary dimension
! should also be replicated. This check is done in ESMF_FieldCreate already
! initialze distgridToArrayMap
do i=1,distDimCount
distgridToArrayMap(i)= i
enddo
! if there is any replicated dimensions, reassign distgridToArrayMap
rep_arb = 0
rep_noarb = 0
if (gridUsedDimCount < dimCount) then
k = 1
do i=1,dimCount
found = .false.
if (localGridToFieldMap(i) == 0) then
do j=1,dimCount
if (distgridToGridMap(j) == i) then
found = .true.
exit
endif
enddo
if (found) then
distgridToArrayMap(arbdim) = 0
rep_arb = 1
else
rep_noarb = rep_noarb+1
if (k == arbdim) k = k + 1
distgridToArrayMap(k) = 0
k=k+1
endif
endif
enddo
j=1
do i=1,distDimCount
if (distgridToArrayMap(i) /= 0) then
distgridToArrayMap(i)= j
j=j+1
endif
enddo
endif
arrayDimCount=ungriddedDimCount+distDimCount-rep_noarb-rep_arb
deallocate(distgridToGridMap)
! construct array based on the presence of distributed dimensions
! if there are undistributed dimensions ...
if (undistArrayDimCount > 0) then
! Copy ungriddedBound to undistBound
if (present (undistLBound)) &
undistLBound(:undistArrayDimCount) = ungriddedLBound(:undistArrayDimCount)
if (present (undistUBound)) &
undistUBound(:undistArrayDimCount) = ungriddedUBound(:undistArrayDimCount)
endif
endif
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridGetArrayInfo
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreate"
!BOP
! !IROUTINE: ESMF_GridCreate - Create a copy of a Grid with a new DistGrid
! !INTERFACE:
! Private name; call using ESMF_GridCreate()
function ESMF_GridCreateCopyFromNewDG(grid, distgrid, keywordEnforcer, &
name, copyAttributes, routehandle, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateCopyFromNewDG
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type(ESMF_DistGrid), intent(in) :: distgrid
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
character (len=*), intent(in), optional :: name
logical, intent(in), optional :: copyAttributes
type(ESMF_RouteHandle),intent(out), optional :: routehandle
integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \item\apiStatusModifiedSinceVersion{5.2.0r}
! \begin{description}
! \item[7.1.0r] Added argument {\tt copyAttributes} to support attribute
! propagation from the existing to the newly created grid object. \newline
! \item[8.2.1] Added argument {\tt routehandle} providing the user with a convenient
! way to execute {\tt ESMF\_GridRedist()} repeatedly, e.g. when coordinates
! on the source grid have changed.
! \end{description}
! \end{itemize}
!
! !DESCRIPTION:
! This call allows the user to copy an existing ESMF Grid, but with a new distribution.
! All internal data from the old Grid (coords, items) are redistributed to the new Grid.
!
! The arguments are:
! \begin{description}
! \item[grid]
! The existing {\tt ESMF\_Grid} being redistributed, i.e. the "source" grid.
! \item[distgrid]
! {\tt ESMF\_DistGrid} object which describes how the newly created Grid is
! decomposed and distributed.
! \item[{[name]}]
! Name of the new Grid. If not specified, a new unique name will be created
! for the Grid.
! \item[{[copyAttributes]}]
! A flag to indicate whether to copy the attributes of the existing grid
! to the new grid. The default value is .false..
! \item[{[routehandle]}]
! If provided holds the mapping of coordinates between the two grids. This can
! be used in the companion method {\tt ESMF\_GridRedist()} to update coordinates.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_Grid) :: newGrid
integer :: localrc ! local error status
type(ESMF_TypeKind_Flag) :: coordTypeKind
integer :: distgridToGridMap(ESMF_MAXDIM)
integer :: coordDimCount(ESMF_MAXDIM)
integer :: coordDimMap(ESMF_MAXDIM,ESMF_MAXDIM)
integer :: gridEdgeLWidth(ESMF_MAXDIM)
integer :: gridEdgeUWidth(ESMF_MAXDIM)
integer :: gridAlign(ESMF_MAXDIM)
integer :: staggerEdgeLWidth(ESMF_MAXDIM)
integer :: staggerEdgeUWidth(ESMF_MAXDIM)
integer :: staggerAlign(ESMF_MAXDIM)
integer :: staggerLBound(ESMF_MAXDIM)
type(ESMF_Index_Flag) :: indexflag, arrayIndexflag
integer :: i, j, nStaggers
#define USE_ARRAYBUNDLE
#ifdef USE_ARRAYBUNDLE
type(ESMF_ArrayBundle) :: srcAB, dstAB
#endif
type(ESMF_RouteHandle) :: rh
type(ESMF_STAGGERLOC), allocatable :: srcStaggers(:)
type(ESMF_Array), allocatable :: srcA(:), dstA(:)
type(ESMF_Array), allocatable :: srcA2D(:), dstA2D(:)
type(ESMF_DistGrid):: dg, oldDistGrid
type(ESMF_TypeKind_Flag):: tk
integer:: atodMap(1), k
real(ESMF_KIND_R8), pointer:: farrayPtr(:), farrayPtr2d(:,:)
integer:: rank, dimCount, maxNumStaggers
logical, allocatable:: srcRepl(:), dstRepl(:)
type(ESMF_GRIDITEM_FLAG) :: gridItemList(ESMF_GRIDITEM_COUNT)=(/ESMF_GRIDITEM_MASK,ESMF_GRIDITEM_AREA/)
type(ESMF_GRIDITEM_FLAG) :: gridItem
type(ESMF_CoordSys_Flag) :: coordSys
integer :: localDECount, localDE
integer :: arbDimCount, arrayDimCount, dgDimCount
integer, allocatable :: minIndex(:), maxIndex(:), indexArray(:,:)
character(len=160) :: msgString
type(ESMF_DistGridMatch_Flag) :: dgMatch
type(ESMF_Info) :: lhs, rhs
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check init status of arguments
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_DistGridGetInit, distgrid, rc)
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, grid, rc)
! Get the old DistGrid
call ESMF_GridGet(grid, distgrid=oldDistGrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
#if 0
if (present(name)) &
call ESMF_LogWrite("ESMF_GridCreateCopyFromNewDG for: "//trim(name), &
ESMF_LOGMSG_INFO)
#endif
! Get info from old grid to create new Grid.
call ESMF_GridGet(grid, &
dimCount=dimCount, arbDimCount=arbDimCount, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get info from target distgrid
call ESMF_DistGridGet(distgrid, dimCount=dgDimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get info from old grid to create new Grid.
call ESMF_GridGet(grid, &
coordTypeKind=coordTypeKind, &
coordSys=coordSys, &
staggerlocCount=maxNumStaggers, &
distgridToGridMap=distgridToGridMap(1:dimCount), &
coordDimCount=coordDimCount(1:dimCount), &
coordDimMap=coordDimMap(1:dimCount,1:dimCount), &
gridEdgeLWidth=gridEdgeLWidth(1:dimCount), &
gridEdgeUWidth=gridEdgeUWidth(1:dimCount), &
gridAlign=gridAlign(1:dimCount), &
indexFlag=indexFlag, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (arbDimCount==0) then
! no arbitrary distribution
#if 0
call ESMF_LogWrite("ESMF_GridCreateCopyFromNewDG no-arb grid", &
ESMF_LOGMSG_INFO)
#endif
! make sure new DistGrid covers the same index space as old DistGrid
dgMatch = ESMF_DistGridMatch(distgrid, oldDistGrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (dgMatch < ESMF_DISTGRIDMATCH_INDEXSPACE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="Old and new DistGrids must cover the same index space.", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Create New Grid
newGrid=ESMF_GridCreate(name=name, &
coordTypeKind=coordTypeKind, &
distgrid=distgrid, &
coordSys=coordSys, &
distgridToGridMap=distgridToGridMap(1:dimCount), &
coordDimCount=coordDimCount(1:dimCount), &
coordDimMap=coordDimMap(1:dimCount,1:dimCount), &
gridEdgeLWidth=gridEdgeLWidth(1:dimCount), &
gridEdgeUWidth=gridEdgeUWidth(1:dimCount), &
gridAlign=gridAlign(1:dimCount), &
! gridMemLBound=gridMemLBound, & ! TODO: NEED TO ADD THIS TO GET
indexFlag=indexFlag, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
! arbitrary distribution
#if 0
call ESMF_LogWrite("ESMF_GridCreateCopyFromNewDG arb grid", &
ESMF_LOGMSG_INFO)
#endif
! make sure new DistGrid has as many elements as old DistGrid
dgMatch = ESMF_DistGridMatch(distgrid, oldDistGrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (dgMatch < ESMF_DISTGRIDMATCH_ELEMENTCOUNT) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="Old and new DistGrids must cover the same index space.", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Two branches here:
!
! If the dimCount of the DistGrid equals the dimCount of the old grid, then a
! non-arbDist grid is being created here (from an arbitrary incoming Grid).
!
! If the dimCount of the incoming DistGrid is smaller than the original grid dimCount,
! the created Grid will also be arbDist.
if (dgDimCount==dimCount) then
! Create the new Grid as regDecomp
#if 0
call ESMF_LogWrite("ESMF_GridCreateCopyFromNewDG arb grid as regDecom", &
ESMF_LOGMSG_INFO)
#endif
newGrid=ESMF_GridCreate(name=name, &
coordTypeKind=coordTypeKind, &
distgrid=distgrid, &
coordSys=coordSys, &
indexFlag=indexFlag, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
elseif (dgDimCount < dimCount) then
! Create the new Grid as arbDistr
#if 0
call ESMF_LogWrite("ESMF_GridCreateCopyFromNewDG arb grid as arbDistr", &
ESMF_LOGMSG_INFO)
#endif
! first must set up the indexArray (which holds index space bounds)
allocate(minIndex(dimCount), maxIndex(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndex, maxIndex", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGet(grid, tile=1, staggerloc=ESMF_STAGGERLOC_CENTER, &
minIndex=minIndex, maxIndex=maxIndex, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(indexArray(2,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating indexArray", &
ESMF_CONTEXT, rcToReturn=rc)) return
indexArray(1,:)=minIndex(:)
indexArray(2,:)=maxIndex(:)
! now create the new arbDistr grid
newGrid=ESMF_GridCreate(name=name, &
indexArray=indexArray, &
coordTypeKind=coordTypeKind, &
distgrid=distgrid, &
coordSys=coordSys, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
deallocate(minIndex, maxIndex, indexArray)
else
! problem condition -> flag error
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="Grid and DistGrid dimCounts are not compatible.", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! Allocate to maximum number of possible staggers
allocate(srcStaggers(maxNumStaggers))
! Get list and number of active staggers
call c_ESMC_gridgetactivestaggers(grid%this, &
nStaggers, srcStaggers, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
#if 0
write (msgString,*) "ESMF_GridCreateCopyFromNewDG(): nStaggers=",nStaggers, &
" dimCount(Grid)=", dimCount
call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
#endif
! Add Coords to new grid
! TODO: handle staggerLBound
do i = 1, nStaggers
call ESMF_GridGet(grid, staggerloc=srcStaggers(i), &
staggerEdgeLWidth=staggerEdgeLWidth(1:dimCount), &
staggerEdgeUWidth=staggerEdgeUWidth(1:dimCount), &
staggerAlign=staggerAlign(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridAddCoord(newGrid, staggerloc=srcStaggers(i), &
staggerEdgeLWidth=staggerEdgeLWidth(1:dimCount), &
staggerEdgeUWidth=staggerEdgeUWidth(1:dimCount), &
staggerAlign=staggerAlign(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
! Create src Arraybundle
! Pull coord Arrays out of old grid and put them into Arraybundle
! for each staggerloc added above
allocate(srcA(dimCount*nStaggers), dstA(dimCount*nStaggers))
allocate(srcA2D(dimCount*nStaggers), dstA2D(dimCount*nStaggers))
allocate(srcRepl(dimCount*nStaggers), dstRepl(dimCount*nStaggers))
do i=1,dimCount
do j = 1, nStaggers
call ESMF_GridGetCoord(grid, coordDim=i, staggerloc=srcStaggers(j), &
array=srcA((i-1)*nStaggers+j), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
enddo
!TODO: gjt: The following is completely hacked for now, just to get the
!TODO: gjt: demo working. Basically the problem is that we don't currently
!TODO: gjt: support communication calls for Arrays with replicated dims.
!TODO: gjt: So I create temporary 2D Arrays, put the coordinates from the
!TODO: gjt: src Grid (1D replicated on 2D DistGrid) onto the 2D Arrays and
!TODO: gjt: Redist() to another temporary set of 2D Arrays on the dst side.
!TODO: gjt: From there it is finally copied into the 1D replicated dst side
!TODO: gjt: coordinate Arrays. - nasty ha!
! construct temporary 2D src Arrays and fill with data if necessary
do k=1, dimCount*nStaggers
call ESMF_ArrayGet(srcA(k), rank=rank, dimCount=arrayDimCount, &
localDECount=localDECount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (rank==arrayDimCount) then
! branch that assumes no replicated dims in Array
! TODO: actually there may still be replication, only
! TODO: arrayToDistGridMap conclusively provides that indication
srcRepl(k) = .false.
srcA2D(k) = srcA(k)
else
! this branch is hard-coded for 2D DistGrids with 1D replicated
! dim Arrays along one dimension
srcRepl(k) = .true.
call ESMF_ArrayGet(srcA(k), distgrid=dg, typekind=tk, &
arrayToDistGridMap=atodMap, indexflag=arrayIndexflag, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
srcA2D(k) = ESMF_ArrayCreate(distgrid=dg, typekind=tk, &
indexflag=arrayIndexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (localDECount/=0) then
call ESMF_ArrayGet(srcA(k), farrayPtr=farrayPtr, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayGet(srcA2D(k), farrayPtr=farrayPtr2D, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (atodMap(1)==1) then
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
farrayPtr2D(i,j) = farrayPtr(i)
enddo
enddo
else
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
farrayPtr2D(i,j) = farrayPtr(j)
enddo
enddo
endif
endif
endif
enddo
#ifdef USE_ARRAYBUNDLE
srcAB = ESMF_ArrayBundleCreate(arrayList=srcA2D, multiflag=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
#endif
! Create dst Arraybundle
! Pull coord Arrays out of new grid and put them into Arraybundle
! for each staggerloc added above
do i=1,dimCount
do j = 1, nStaggers
call ESMF_GridGetCoord(newGrid, coordDim=i, staggerloc=srcStaggers(j), &
array=dstA((i-1)*nStaggers+j), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
enddo
! construct temporary 2D Arrays
do k=1, dimCount*nStaggers
call ESMF_ArrayGet(dstA(k), rank=rank, dimCount=arrayDimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (rank==arrayDimCount) then
! branch that assumes no replicated dims in Array
! TODO: actually there may still be replication, only
! TODO: arrayToDistGridMap conclusively provides that indication
dstRepl(k) = .false.
dstA2D(k) = dstA(k)
else
dstRepl(k) = .true.
call ESMF_ArrayGet(dstA(k), distgrid=dg, typekind=tk, &
indexflag=arrayIndexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
dstA2D(k) = ESMF_ArrayCreate(distgrid=dg, typekind=tk, &
indexflag=arrayIndexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
enddo
#ifdef USE_ARRAYBUNDLE
dstAB = ESMF_ArrayBundleCreate(arrayList=dstA2D, multiflag=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
#endif
#if 0
call ESMF_LogWrite("ESMF_GridCreateCopyFromNewDG before coord RedistStore()",&
ESMF_LOGMSG_INFO)
#endif
#ifdef USE_ARRAYBUNDLE
if (dimCount*nStaggers > 0) then
! Redist between ArrayBundles
call ESMF_ArrayBundleRedistStore(srcAB, dstAB, routehandle=rh, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayBundleRedist(srcAB, dstAB, routehandle=rh, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
! Conditionally return the valid routehandle, or destroy here
if (present(routehandle)) then
routehandle = rh
else
call ESMF_ArrayBundleRedistRelease(routehandle=rh, noGarbage=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
endif
endif
! Destroy ArrayBundles
call ESMF_ArrayBundleDestroy(srcAB, noGarbage=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayBundleDestroy(dstAB, noGarbage=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
#else
!gjt thinks this comment is outdates, and was due to a silly mistake that was in earlier code when
!gjt creating the ArrayBundles.
!TODO: figure out why ArrayBundleRedist() does not seem to work right for
!TODO: some of the Arrays -> use individual ArrayRedist() instead as work-around
do k=1, dimCount*nStaggers
call ESMF_ArrayRedistStore(srcA2D(k), dstA2D(k), routehandle=rh, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayRedist(srcA2D(k), dstA2D(k), routehandle=rh, &
zeroregion=ESMF_REGION_TOTAL, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayRedistRelease(routehandle=rh, noGarbage=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
#endif
#if 0
call ESMF_LogWrite("ESMF_GridCreateCopyFromNewDG after coord RedistStore()",&
ESMF_LOGMSG_INFO)
#endif
! Fill the replicated dimension Arrays from the 2D redist data
do k=1, dimCount*nStaggers
if (dstRepl(k)) then
call ESMF_ArrayGet(dstA(k), arrayToDistGridMap=atodMap, &
localDECount=localDECount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
do localDE=0, localDECount-1
call ESMF_ArrayGet(dstA(k), localDE=localDE, &
farrayPtr=farrayPtr, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayGet(dstA2D(k), localDE=localDE, &
farrayPtr=farrayPtr2D, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (atodMap(1)==1) then
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
farrayPtr(i) = farrayPtr2D(i,lbound(farrayPtr2D,2))
enddo
else
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
farrayPtr(j) = farrayPtr2D(lbound(farrayPtr2D,1),j)
enddo
endif
enddo
endif
enddo
! clean up temporary Arrays
do k=1, dimCount*nStaggers
if (srcRepl(k)) then
call ESMF_ArrayDestroy(srcA2D(k), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (dstRepl(k)) then
call ESMF_ArrayDestroy(dstA2D(k), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
enddo
deallocate(srcA)
deallocate(srcA2D)
deallocate(dstA)
deallocate(dstA2D)
deallocate(srcRepl)
deallocate(dstRepl)
#if 1
!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Redist Item Data
do i=1,ESMF_GRIDITEM_COUNT
! Get each grid item
gridItem=gridItemList(i)
! Get list and number of active staggersfor this item
call c_ESMC_gridgetactiveitemstag(grid%this, &
gridItem, nStaggers, srcStaggers, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! If no staggers then go to next item
if (nStaggers .eq. 0) cycle
! Add Items to new grid
do j = 1, nStaggers
call ESMF_GridAddItem(newGrid, staggerloc=srcStaggers(j), &
itemflag=gridItem, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
! allocate space to hold arrays
allocate(srcA(nStaggers), dstA(nStaggers))
! Pull item Arrays out of old grid for each staggerloc added above
do j = 1, nStaggers
call ESMF_GridGetItem(grid, staggerloc=srcStaggers(j), &
itemFlag=gridItem, array=srcA(j), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
! Pull item Arrays out of new grid for each staggerloc added above
do j = 1, nStaggers
call ESMF_GridGetItem(newGrid, staggerloc=srcStaggers(j), &
itemflag=gridItem, array=dstA(j), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
#if 0
call ESMF_LogWrite("ESMF_GridCreateCopyFromNewDG before item RedistStore()",&
ESMF_LOGMSG_INFO)
#endif
! Gerhard had a note that Arraybundle redist doesn't seem to always work
! so just do individual redists until you check with him
!srcAB = ESMF_ArrayBundleCreate(arrayList=srcA(1:nStaggers), rc=localrc)
!if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
! ESMF_CONTEXT, rcToReturn=rc)) return
!dstAB = ESMF_ArrayBundleCreate(arrayList=dstA(1:nStaggers), rc=localrc)
!if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
! ESMF_CONTEXT, rcToReturn=rc)) return
! Redist between ArrayBundles
! call ESMF_ArrayBundleRedistStore(srcAB, dstAB, routehandle=rh, rc=localrc)
! if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
! ESMF_CONTEXT, rcToReturn=rc)) return
! call ESMF_ArrayBundleRedist(srcAB, dstAB, routehandle=rh, rc=localrc)
! if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
! ESMF_CONTEXT, rcToReturn=rc)) return
do j=1, nStaggers
call ESMF_ArrayRedistStore(srcA(j), dstA(j), routehandle=rh, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayRedist(srcA(j), dstA(j), routehandle=rh, &
zeroregion=ESMF_REGION_TOTAL, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayRedistRelease(routehandle=rh, noGarbage=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
#if 0
call ESMF_LogWrite("ESMF_GridCreateCopyFromNewDG after item RedistStore()",&
ESMF_LOGMSG_INFO)
#endif
! Get rid of lists of arrays
deallocate(srcA)
deallocate(dstA)
! Destroy ArrayBundles and release Routehandle
! call ESMF_ArrayBundleRedistRelease(routehandle=rh, noGarbage=.true., rc=localrc)
! if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
! ESMF_CONTEXT, rcToReturn=rc)) return
!call ESMF_ArrayBundleDestroy(srcAB, rc=localrc)
!if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
! ESMF_CONTEXT, rcToReturn=rc)) return
!call ESMF_ArrayBundleDestroy(dstAB, rc=localrc)
!if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
! ESMF_CONTEXT, rcToReturn=rc)) return
enddo
#endif
! Copy Attributes
if (present(copyAttributes)) then
if (copyAttributes) then
call ESMF_InfoGetFromPointer(newGrid%this, lhs, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InfoGetFromPointer(grid%this, rhs, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InfoUpdate(lhs, rhs, recursive=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
endif
! deallocate stagger list
deallocate(srcStaggers)
! Set return value
ESMF_GridCreateCopyFromNewDG = newGrid
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreateCopyFromNewDG
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateCopyFromReg"
!BOP
! !IROUTINE: ESMF_GridCreate - Create a copy of a Grid with a different regular distribution
! !INTERFACE:
! Private name; call using ESMF_GridCreate()
function ESMF_GridCreateCopyFromReg(grid, keywordEnforcer, &
regDecomp, decompFlag, name, copyAttributes, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateCopyFromReg
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(in), optional :: regDecomp(:)
type(ESMF_Decomp_Flag), intent(in), optional :: decompflag(:)
character (len=*), intent(in), optional :: name
logical, intent(in), optional :: copyAttributes
integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \item\apiStatusModifiedSinceVersion{5.2.0r}
! \begin{description}
! \item[7.1.0r] Added argument {\tt copyAttributes} to support attribute
! propagation from the existing to the newly created grid object.
! \end{description}
! \end{itemize}
!
! !DESCRIPTION:
!
! This method creates a copy of an existing Grid, the new Grid is
! regularly distributed (see Figure \ref{fig:GridDecomps}).
! To specify the new distribution, the user passes in an array
! ({\tt regDecomp}) specifying the number of DEs to divide each
! dimension into. The array {\tt decompFlag} indicates how the division into DEs is to
! occur. The default is to divide the range as evenly as possible.
!
! The arguments are:
! \begin{description}
! \item[grid]
! {\tt ESMF\_Grid} to copy.
! \item[{[regDecomp]}]
! List that has the same number of elements as {\tt maxIndex}.
! Each entry is the number of decounts for that dimension.
! If not specified, the default decomposition will be petCountx1x1..x1.
! \item[{[decompflag]}]
! List of decomposition flags indicating how each dimension of the
! tile is to be divided between the DEs. The default setting
! is {\tt ESMF\_DECOMP\_BALANCED} in all dimensions. Please see
! Section~\ref{const:decompflag} for a full description of the
! possible options. Note that currently the option
! {\tt ESMF\_DECOMP\_CYCLIC} isn't supported in Grid creation.
! \item[{[name]}]
! Name of the new Grid. If not specified, a new unique name will be
! created for the Grid.
! \item[{[copyAttributes]}]
! A flag to indicate whether to copy the attributes of the existing grid
! to the new grid. The default value is .false..
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_DistGrid) :: distgrid
type(ESMF_DistGrid) :: oldDistgrid
type(ESMF_DELayout) :: delayout
type(ESMF_VM) :: vm
integer, pointer :: petList(:)
integer :: localrc
integer :: dimCount,i
integer, pointer :: regDecompLocal(:)
type(ESMF_Decomp_Flag), pointer :: decompflagLocal(:)
integer :: deCount
integer :: i1,i2,i3,k, tileCount
integer,pointer :: minIndexPDimPTile(:,:)
integer,pointer :: maxIndexPDimPTile(:,:)
integer,pointer :: minIndexLocal(:)
integer,pointer :: maxIndexLocal(:)
type(ESMF_Index_Flag) :: indexflag
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Get the Grid DimCount ---------------------------------------------------
call ESMF_GridGet(grid, dimCount=dimCount, indexflag=indexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Argument Consistency Checking --------------------------------------------------------------
if (present(regDecomp)) then
if (size(regDecomp) .lt. dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- regDecomp size doesn't match Grid dimCount ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(decompFlag)) then
if (size(decompFlag) .lt. dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- decompFlag size doesn't match Grid dimCount ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! CYCLIC decomposition isn't allowed when creating a Grid
do i=1,size(decompFlag)
if (decompFlag(i) == ESMF_DECOMP_CYCLIC) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_OUTOFRANGE, &
msg="- decompFlag isn't allowed to be" // &
" ESMF_DECOMP_CYCLIC when creating a Grid.", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
enddo
endif
! Get min/max Index from old grid ------------------------------------------------------------------
! Get old distgrid
call ESMF_GridGet(grid, distgrid=oldDistgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get a couple of sizes
call ESMF_DistgridGet(oldDistgrid, tileCount=tileCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get Index info from DistGrid
allocate(minIndexPDimPTile(dimCount,tileCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndexPDimTile", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(maxIndexPDimPTile(dimCount,tileCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxIndexPDimTile", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_DistgridGet(oldDistgrid, &
minIndexPTile=minIndexPDimPTile, &
maxIndexPTile=maxIndexPDimPTile, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! This doesn't work right now for Multitile Grids
if (tileCount > 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- GridCopy with reg distribution not supported for multitile grids", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Set minIndex
allocate(minIndexLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
minIndexLocal(1:dimCount)=minIndexPDimPTile(1:dimCount,1)
! Set maxIndex
allocate(maxIndexLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
maxIndexLocal(1:dimCount)=maxIndexPDimPTile(1:dimCount,1)
! Free memory from distgrid get
deallocate(minIndexPDimPTile)
deallocate(maxIndexPDimPTile)
! Set default for regDecomp
allocate(regDecompLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating regDecompLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(regDecomp)) then
regDecompLocal(:)=regDecomp(:)
else
! The default is 1D divided among all the Pets
call ESMF_VMGetCurrent(vm,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_VMGet(vm,petCount=regDecompLocal(1),rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
do i=2,dimCount
regDecompLocal(i)=1
enddo
endif
! Set default for decomp flag based on gridEdgeWidths -----------------------------------
! NOTE: This is a temporary fix until we have something better implemented in distGrid
! Set default for decompFlag
allocate(decompFlagLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating decompFlagLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(decompFlag)) then
decompFlagLocal(:)=decompFlag(:)
else
decompFlagLocal(:)=ESMF_DECOMP_BALANCED
endif
! Process PetMap --------------------------------------------------------------
!! Calculate deCount
deCount=1
do i=1,dimCount
deCount=deCount*regDecompLocal(i)
enddo
#if 0
! create DELayout based on presence of petMap
if (present(petMap)) then
!! Allocate petList
allocate(petList(deCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, "Allocating petList", &
ESMF_CONTEXT, rcToReturn=rc)) return
!! copy petMap to petList
if (dimCount > 2) then
k=1
do i3=1,regDecompLocal(3)
do i2=1,regDecompLocal(2)
do i1=1,regDecompLocal(1)
petList(k)=petMap(i1,i2,i3)
k=k+1
enddo
enddo
enddo
else
k=1
do i3=1,1
do i2=1,regDecompLocal(2)
do i1=1,regDecompLocal(1)
petList(k)=petMap(i1,i2,i3)
k=k+1
enddo
enddo
enddo
endif
!! create delayout from the petList
delayout=ESMF_DELayoutCreate(petMap=petList,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! Get rid of list
deallocate(petList)
else
#endif
!! create a default delayout
delayout=ESMF_DELayoutCreate(deCount=deCount,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
#if 0
endif
#endif
! Create DistGrid --------------------------------------------------------------
distgrid=ESMF_DistGridCreate(minIndex=minIndexLocal, maxIndex=maxIndexLocal, &
regDecomp=regDecompLocal, decompFlag=decompFlagLocal, delayout=delayout,&
indexflag=indexflag, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(name)) then
call ESMF_DistGridSet(distgrid, name="DG-"//trim(name), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
ESMF_GridCreateCopyFromReg=ESMF_GridCreate(grid, distgrid, &
name=name, copyAttributes=copyAttributes, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set internal items to be destroyed with grid
call ESMF_GridSetDestroyDistgrid(grid,destroy=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout(grid,destroy=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(regDecompLocal)
deallocate(decompFlagLocal)
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreateCopyFromReg
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateEdgeConnI"
!BOP
! !IROUTINE: ESMF_GridCreate - Create a Grid with user set edge connections and an irregular distribution
! !INTERFACE:
! Private name; call using ESMF_GridCreate()
function ESMF_GridCreateEdgeConnI(minIndex, &
countsPerDEDim1,countsPerDeDim2, keywordEnforcer, &
countsPerDEDim3, &
connflagDim1, connflagDim2, connflagDim3, &
coordSys, coordTypeKind, &
coordDep1, coordDep2, coordDep3, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridMemLBound, indexflag, petMap, name, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateEdgeConnI
!
! !ARGUMENTS:
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: countsPerDEDim1(:)
integer, intent(in) :: countsPerDEDim2(:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(in), optional :: countsPerDEDim3(:)
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim1(:)
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim2(:)
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim3(:)
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(in), optional :: gridEdgeLWidth(:)
integer, intent(in), optional :: gridEdgeUWidth(:)
integer, intent(in), optional :: gridAlign(:)
integer, intent(in), optional :: gridMemLBound(:)
type(ESMF_Index_Flag), intent(in), optional :: indexflag
integer, intent(in), optional :: petMap(:,:,:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method creates a single tile, irregularly distributed grid
! (see Figure \ref{fig:GridDecomps}).
! To specify the irregular distribution, the user passes in an array
! for each grid dimension, where the length of the array is the number
! of DEs in the dimension. Currently this call only
! supports creating 2D or 3D Grids. A 2D Grid can be specified using the
! countsPerDEDim1 and countsPerDEDim2 arguments. A 3D Grid can
! be specified by also using the optional countsPerDEDim3 argument.
! The index of each array element in these arguments corresponds to
! a DE number. The array value at the index is the number of grid
! cells on the DE in that dimension.
!
! Section \ref{example:2DIrregUniGrid} shows an example
! of using this method to create a 2D Grid with uniformly spaced
! coordinates. This creation method can also be used as the basis for
! grids with rectilinear coordinates or curvilinear coordinates.
!
! The arguments are:
! \begin{description}
! \item[{[minIndex]}]
! Tuple to start the index ranges at. If not present, defaults
! to /1,1,1,.../.
! \item[countsPerDEDim1]
! This arrays specifies the number of cells per DE for index dimension 1
! for the exclusive region (the center stagger location).
! \item[countsPerDEDim2]
! This array specifies the number of cells per DE for index dimension 2
! for the exclusive region (center stagger location).
! \item[{[countsPerDEDim3]}]
! This array specifies the number of cells per DE for index dimension 3
! for the exclusive region (center stagger location).
! If not specified then grid is 2D.
! \item[{[connflagDim1]}]
! Fortran array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! \item[{[connflagDim2]}]
! Fortran array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! \item[{[connflagDim3]}]
! Fortran array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! For a full list of options, please see Section~\ref{const:coordsys}.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[coordDep1]}]
! This array specifies the dependence of the first
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the first
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep2]}]
! This array specifies the dependence of the second
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the second
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep3]}]
! This array specifies the dependence of the third
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the third
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[gridEdgeLWidth]}]
! The padding around the lower edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 0, 0, ..., 0 (all zeros).
! \item[{[gridEdgeUWidth]}]
! The padding around the upper edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 1, 1, ..., 1 (all ones).
! \item[{[gridAlign]}]
! Specification of how the stagger locations should align with the cell
! index space (can be overridden by the individual staggerAligns). If
! the gridEdgeWidths are not specified than this argument
! implies the gridEdgeWidths. If the gridEdgeWidths are specified and this argument isn't
! then this argument is implied by the gridEdgeWidths.
! If this and the gridEdgeWidths are not specified, then defaults to
! -1, -1, ..., -1 (all negative ones).
! \item[{[gridMemLBound]}]
! Specifies the lower index range of the memory of every DE in this Grid.
! Only used when indexflag is {\tt ESMF\_INDEX\_USER}. May be overridden
! by staggerMemLBound.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[petMap]}]
! \begin{sloppypar}
! Sets the mapping of pets to the created DEs. This 3D
! should be of size size(countsPerDEDim1) x size(countsPerDEDim2) x
! size(countsPerDEDim3). If countsPerDEDim3 isn't present, then
! the last dimension is of size 1.
! \end{sloppypar}
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_DistGrid) :: distgrid
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer :: localrc
integer :: dimCount
integer, pointer :: gridEdgeLWidthLocal(:)
integer, pointer :: gridEdgeUWidthLocal(:)
integer, pointer :: gridAlignLocal(:)
integer, pointer :: minIndexLocal(:)
integer, pointer :: maxIndexLocal(:)
type(ESMF_DistgridConnection), pointer :: connList(:)
type(ESMF_CoordSys_Flag) :: coordSysLocal
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Get the dimension and extent of the index space
call GetIndexSpaceIrreg(minIndex, &
countsPerDEDim1,countsPerDeDim2, &
countsPerDEDim3, dimCount, minIndexLocal, maxIndexLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Build connection list
call SetupTileConn(dimCount, minIndexLocal, maxIndexLocal, &
connflagDim1, connflagDim2, connflagDim3, connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Create Irregular distgrid and error check associated input and set defaults
distgrid=ESMF_GridCreateDistgridIrreg(dimCount, minIndexLocal, maxIndexLocal, &
countsPerDEDim1,countsPerDeDim2, &
countsPerDEDim3, indexflag, petMap, connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set default widths and alignment and error check
allocate(gridEdgeLWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeLWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridEdgeUWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeUWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridAlignLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridAlignLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridLUADefault(dimCount, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridEdgeLWidthLocal, gridEdgeUWidthLocal, gridAlignLocal, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Convert coordDeps to coordDimCount and coordDimMap
allocate(coordDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimCount", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(coordDimMap(dimCount,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
call CoordInfoFromCoordDep(dimCount, coordDep1, coordDep2, coordDep3,&
coordDimCount, coordDimMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set Default coordSys
if (present(coordSys)) then
coordSysLocal=coordSys
else
coordSysLocal=ESMF_COORDSYS_SPH_DEG
endif
! Create Grid from specification
ESMF_GridCreateEdgeConnI=ESMF_GridCreateFrmDistGrid( &
distgrid, &
coordSys=coordSysLocal, &
coordTypeKind=coordTypeKind, &
coordDimCount=coordDimCount, coordDimMap=coordDimMap, &
gridEdgeLWidth=gridEdgeLWidthLocal, &
gridEdgeUWidth=gridEdgeUWidthLocal, &
gridAlign=gridAlignLocal, &
gridMemLBound=gridMemLBound, &
indexflag=indexflag, &
name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set internal items to be destroyed with grid
Call ESMF_GridSetDestroyDistgrid( ESMF_GridCreateEdgeConnI,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout( ESMF_GridCreateEdgeConnI,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(connList)
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
deallocate(coordDimCount)
deallocate(coordDimMap)
deallocate(gridEdgeLWidthLocal)
deallocate(gridEdgeUWidthLocal)
deallocate(gridAlignLocal)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreateEdgeConnI
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateEdgeConnR"
!BOP
! !IROUTINE: ESMF_GridCreate - Create a Grid with user set edge connections and a regular distribution
! !INTERFACE:
! Private name; call using ESMF_GridCreate()
function ESMF_GridCreateEdgeConnR(regDecomp, decompFlag, &
minIndex, maxIndex, keywordEnforcer, &
connflagDim1, connflagDim2, connflagDim3, &
coordSys, coordTypeKind, &
coordDep1, coordDep2, coordDep3, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridMemLBound, indexflag, petMap, name, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateEdgeConnR
!
! !ARGUMENTS:
integer, intent(in), optional :: regDecomp(:)
type(ESMF_Decomp_Flag), intent(in), optional :: decompflag(:)
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: maxIndex(:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim1(:)
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim2(:)
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim3(:)
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(in), optional :: gridEdgeLWidth(:)
integer, intent(in), optional :: gridEdgeUWidth(:)
integer, intent(in), optional :: gridAlign(:)
integer, intent(in), optional :: gridMemLBound(:)
type(ESMF_Index_Flag), intent(in), optional :: indexflag
integer, intent(in), optional :: petMap(:,:,:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method creates a single tile, regularly distributed grid
! (see Figure \ref{fig:GridDecomps}).
! To specify the distribution, the user passes in an array
! ({\tt regDecomp}) specifying the number of DEs to divide each
! dimension into. The array {\tt decompFlag} indicates how the division into DEs is to
! occur. The default is to divide the range as evenly as possible. Currently this call
! only supports creating a 2D or 3D Grid, and thus, for example, {\tt maxIndex} must be of size 2 or 3.
!
! The arguments are:
! \begin{description}
! \item[{[regDecomp]}]
! List that has the same number of elements as {\tt maxIndex}.
! Each entry is the number of decounts for that dimension.
! If not specified, the default decomposition will be petCountx1x1..x1.
! \item[{[decompflag]}]
! List of decomposition flags indicating how each dimension of the
! tile is to be divided between the DEs. The default setting
! is {\tt ESMF\_DECOMP\_BALANCED} in all dimensions. Please see
! Section~\ref{const:decompflag} for a full description of the
! possible options. Note that currently the option
! {\tt ESMF\_DECOMP\_CYCLIC} isn't supported in Grid creation.
! \item[{[minIndex]}]
! The bottom extent of the grid array. If not given then the value defaults
! to /1,1,1,.../.
! \item[maxIndex]
! The upper extent of the grid array.
! \item[{[connflagDim1]}]
! Fortran array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! \item[{[connflagDim2]}]
! Fortran array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! \item[{[connflagDim3]}]
! Fortran array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! For a full list of options, please see Section~\ref{const:coordsys}.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[coordDep1]}]
! This array specifies the dependence of the first
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the first
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep2]}]
! This array specifies the dependence of the second
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the second
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep3]}]
! This array specifies the dependence of the third
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the third
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[gridEdgeLWidth]}]
! The padding around the lower edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 0, 0, ..., 0 (all zeros).
! \item[{[gridEdgeUWidth]}]
! The padding around the upper edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 1, 1, ..., 1 (all ones).
! \item[{[gridAlign]}]
! Specification of how the stagger locations should align with the cell
! index space (can be overridden by the individual staggerAligns). If
! the gridEdgeWidths are not specified than this argument
! implies the gridEdgeWidths. If the gridEdgeWidths are specified and this argument isn't
! then this argument is implied by the gridEdgeWidths.
! If this and the gridEdgeWidths are not specified, then defaults to
! -1, -1, ..., -1 (all negative ones).
! \item[{[gridMemLBound]}]
! Specifies the lower index range of the memory of every DE in this Grid.
! Only used when indexflag is {\tt ESMF\_INDEX\_USER}. May be overridden
! by staggerMemLBound.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[petMap]}]
! Sets the mapping of pets to the created DEs. This 3D
! should be of size regDecomp(1) x regDecomp(2) x regDecomp(3)
! If the Grid is 2D, then the last dimension is of size 1.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_DistGrid) :: distgrid
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer, pointer :: gridEdgeLWidthLocal(:)
integer, pointer :: gridEdgeUWidthLocal(:)
integer, pointer :: gridAlignLocal(:)
integer :: dimCount
integer, pointer :: minIndexLocal(:)
integer, pointer :: maxIndexLocal(:)
integer :: localrc
type(ESMF_DistgridConnection), pointer :: connList(:)
type(ESMF_CoordSys_Flag) :: coordSysLocal
!XX
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Get IndexSpace
call GetIndexSpaceReg(minIndex, maxIndex, &
dimCount, minIndexLocal, maxIndexLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Build connection list
call SetupTileConn(dimCount, minIndexLocal, maxIndexLocal, &
connflagDim1, connflagDim2, connflagDim3, connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Compute regular distgrid and error check associated input and set defaults
distgrid=ESMF_GridCreateDistgridReg(dimCount, minIndexLocal, maxIndexLocal, &
regDecomp, decompFlag, indexflag, petMap, connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set default widths and alignment and error check
allocate(gridEdgeLWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeLWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridEdgeUWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeUWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridAlignLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridAlignLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridLUADefault(dimCount, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridEdgeLWidthLocal, gridEdgeUWidthLocal, gridAlignLocal, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Convert coordDeps to coordDimCount and coordDimMap
allocate(coordDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimCount", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(coordDimMap(dimCount,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
call CoordInfoFromCoordDep(dimCount, coordDep1, coordDep2, coordDep3,&
coordDimCount, coordDimMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set Default coordSys
if (present(coordSys)) then
coordSysLocal=coordSys
else
coordSysLocal=ESMF_COORDSYS_SPH_DEG
endif
! Create Grid from specification
ESMF_GridCreateEdgeConnR=ESMF_GridCreateFrmDistGrid(&
distgrid, &
coordSys=coordSysLocal, &
coordTypeKind=coordTypeKind, &
coordDimCount=coordDimCount, coordDimMap=coordDimMap, &
gridEdgeLWidth=gridEdgeLWidthLocal, &
gridEdgeUWidth=gridEdgeUWidthLocal, &
gridAlign=gridAlignLocal, &
gridMemLBound=gridMemLBound, &
indexflag=indexflag, &
name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set internal items to be destroyed with grid
call ESMF_GridSetDestroyDistgrid(ESMF_GridCreateEdgeConnR,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout(ESMF_GridCreateEdgeConnR,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(connList)
deallocate(coordDimCount)
deallocate(coordDimMap)
deallocate(gridEdgeLWidthLocal)
deallocate(gridEdgeUWidthLocal)
deallocate(gridAlignLocal)
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreateEdgeConnR
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateEdgeConnA"
!BOP
! !IROUTINE: ESMF_GridCreate - Create a Grid with user set edge connections and an arbitrary distribution
! !INTERFACE:
! Private name; call using ESMF_GridCreate()
function ESMF_GridCreateEdgeConnA(minIndex, maxIndex, &
arbIndexCount, arbIndexList, keywordEnforcer, &
connflagDim1, connflagDim2, connflagDim3, &
coordSys, coordTypeKind, &
coordDep1, coordDep2, coordDep3, &
distDim, name, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateEdgeConnA
!
! !ARGUMENTS:
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: maxIndex(:)
integer, intent(in) :: arbIndexCount
integer, intent(in) :: arbIndexList(:,:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim1(:)
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim2(:)
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim3(:)
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(in), optional :: distDim(:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method creates a single tile, arbitrarily distributed grid
! (see Figure \ref{fig:GridDecomps}).
! To specify the arbitrary distribution, the user passes in an 2D array
! of local indices, where the first dimension is the number of local grid cells
! specified by {\tt localArbIndexCount} and the second dimension is the number of distributed
! dimensions.
!
! {\tt distDim} specifies which grid dimensions are arbitrarily distributed. The
! size of {\tt distDim} has to agree with the size of the second dimension of
! {\tt localArbIndex}.
!
! Currently this call
! only supports creating a 2D or 3D Grid, and thus, for example, {\tt maxIndex} must be of size 2 or 3.
!
!
! The arguments are:
! \begin{description}
! \item[{[minIndex]}]
! Tuple to start the index ranges at. If not present, defaults
! to /1,1,1,.../.
! \item[maxIndex]
! The upper extend of the grid index ranges.
! \item[arbIndexCount]
! The number of grid cells in the local DE. It is okay to have 0
! grid cell in a local DE.
! \item[arbIndexList]
! This 2D array specifies the indices of the PET LOCAL grid cells. The
! dimensions should be arbIndexCount * number of Distributed grid dimensions
! where arbIndexCount is the input argument specified below
! \item[{[connflagDim1]}]
! Fortran array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! \item[{[connflagDim2]}]
! Fortran array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! \item[{[connflagDim3]}]
! Fortran array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! For a full list of options, please see Section~\ref{const:coordsys}.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[coordDep1]}]
! The size of the array specifies the number of dimensions of the
! first coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. The format should be /ESMF\_DIM\_ARB/ where
! /ESMF\_DIM\_ARB/ is mapped to the collapsed 1D dimension from all
! the arbitrarily distributed dimensions. n is the dimension that
! is not distributed (if exists).
! If not present the default is /ESMF\_DIM\_ARB/ if the first dimension
! is arbitararily distributed, or /n/ if not distributed (i.e. n=1)
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_DIM\_ARB.
! \item[{[coordDep2]}]
! The size of the array specifies the number of dimensions of the
! second coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. The format should be /ESMF\_DIM\_ARB/ where
! /ESMF\_DIM\_ARB/ is mapped to the collapsed 1D dimension from all
! the arbitrarily distributed dimensions. n is the dimension that
! is not distributed (if exists).
! If not present the default is /ESMF\_DIM\_ARB/ if this dimension
! is arbitararily distributed, or /n/ if not distributed (i.e. n=2)
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_DIM\_ARB.
! \item[{[coordDep3]}]
! The size of the array specifies the number of dimensions of the
! third coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. The format should be /ESMF\_DIM\_ARB/ where
! /ESMF\_DIM\_ARB/ is mapped to the collapsed 1D dimension from all
! the arbitrarily distributed dimensions. n is the dimension that
! is not distributed (if exists).
! If not present the default is /ESMF\_DIM\_ARB/ if this dimension
! is arbitararily distributed, or /n/ if not distributed (i.e. n=3)
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_DIM\_ARB.
! \item[{[distDim]}]
! This array specifies which dimensions are arbitrarily distributed.
! The size of the array specifies the total distributed dimensions.
! if not specified, defaults is all dimensions will be arbitrarily
! distributed. The size has to agree with the size of the second
! dimension of {\tt localArbIndex}.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_DistGrid) :: distgrid
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer :: localrc
integer :: dimCount,distDimCount
integer :: i
integer, pointer :: indexArray(:,:)
logical, pointer :: isDistLocal(:)
integer, pointer :: distDimLocal(:)
integer, pointer :: minIndexLocal(:)
integer, pointer :: maxIndexLocal(:)
type(ESMF_DistgridConnection), pointer :: connList(:)
type(ESMF_CoordSys_Flag) :: coordSysLocal
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Get description of index space and what's undistributed
call GetIndexSpaceArb(minIndex, maxIndex, &
arbIndexCount, arbIndexList, distDim, &
dimCount, distDimCount, isDistLocal, distDimLocal, &
minIndexLocal, maxIndexLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Build connection list
call SetupTileConn(dimCount, minIndexLocal, maxIndexLocal, &
connflagDim1, connflagDim2, connflagDim3, connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Create arbitrary distgrid
distgrid= ESMF_GridCreateDistgridArb(dimCount, distDimCount, isDistLocal, distDimLocal, &
minIndexLocal, maxIndexLocal, arbIndexCount, arbIndexList, connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Convert coordDeps to coordDimCount and coordDimMap
allocate(coordDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimCount", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(coordDimMap(dimCount,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
call CoordInfoFromCoordDepArb(dimCount, isDistLocal, coordDep1, coordDep2, coordDep3,&
coordDimCount, coordDimMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Put minIndex, maxIndex into indexArray for create from distgrid
allocate(indexArray(2,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating indexArray", &
ESMF_CONTEXT, rcToReturn=rc)) return
indexArray(1,:)=minIndexLocal(:)
indexArray(2,:)=maxIndexLocal(:)
! Set Default coordSys
if (present(coordSys)) then
coordSysLocal=coordSys
else
coordSysLocal=ESMF_COORDSYS_SPH_DEG
endif
! Create Grid from specification -----------------------------------------------
ESMF_GridCreateEdgeConnA=ESMF_GridCreateFrmDistGridArb( &
distgrid, indexArray, &
distDim=distDimLocal, &
coordSys=coordSysLocal, &
coordTypeKind=coordTypeKind, &
coordDimCount=coordDimCount, coordDimMap=coordDimMap, &
name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set internal items to be destroyed with grid
call ESMF_GridSetDestroyDistgrid(ESMF_GridCreateEdgeConnA,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout(ESMF_GridCreateEdgeConnA,destroy=.false., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(connList)
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
deallocate(isDistLocal)
deallocate(indexArray)
deallocate(distDimLocal)
deallocate(coordDimCount)
deallocate(coordDimMap)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreateEdgeConnA
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreate"
!BOP
! !IROUTINE: ESMF_GridCreate - Create a Grid from a DistGrid
! !INTERFACE:
! Private name; call using ESMF_GridCreate()
function ESMF_GridCreateFrmDistGrid(distgrid, &
distgridToGridMap, &
coordSys, coordTypeKind, coordDimCount, coordDimMap, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridMemLBound, indexflag, name, vm, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateFrmDistGrid
!
! !ARGUMENTS:
type(ESMF_DistGrid), intent(in) :: distgrid
integer, intent(in), optional :: distgridToGridMap(:)
type(ESMF_CoordSys_Flag),intent(in), optional :: coordSys
type(ESMF_TypeKind_Flag),intent(in), optional :: coordTypeKind
integer, intent(in), optional :: coordDimCount(:)
integer, intent(in), optional :: coordDimMap(:,:)
integer, intent(in), optional :: gridEdgeLWidth(:)
integer, intent(in), optional :: gridEdgeUWidth(:)
integer, intent(in), optional :: gridAlign(:)
integer, intent(in), optional :: gridMemLBound(:)
type(ESMF_Index_Flag), intent(in), optional :: indexflag
character (len=*), intent(in), optional :: name
type(ESMF_VM), intent(in), optional :: vm
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This is the most general form of creation for an {\tt ESMF\_Grid}
! object. It allows the user to fully specify the topology and index space
! using the DistGrid methods and then build a grid out
! of the resulting DistGrid. Note that since the Grid created by this call
! uses {\tt distgrid} as a description of its index space, the resulting Grid
! will have exactly the same number of dimensions (i.e. the same dimCount) as
! {\tt distgrid}. The {\tt distgridToGridMap} argument
! specifies how the Grid dimensions are mapped to the {\tt distgrid}.
! The {\tt coordDimCount} and {\tt coordDimMap} arguments
! allow the user to specify how the coordinate arrays should map to the grid
! dimensions. (Note, though, that creating a grid does not allocate coordinate
! storage. A method such as {\tt ESMF\_GridAddCoord()} must be called
! before adding coordinate values.)
!
! The arguments are:
! \begin{description}
! \item[distgrid]
! {\tt ESMF\_DistGrid} object that describes how the array is decomposed and
! distributed over DEs.
! \item[{[distgridToGridMap]}]
! List that has dimCount elements.
! The elements map each dimension of distgrid to a dimension in the grid.
! (i.e. the values should range from 1 to dimCount). If not specified, the default
! is to map all of distgrid's dimensions against the dimensions of the
! grid in sequence.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! For a full list of options, please see Section~\ref{const:coordsys}.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[coordDimCount]}]
! List that has dimCount elements.
! Gives the dimension of each component (e.g. x) array. This is
! to allow factorization of the coordinate arrays. If not specified
! all arrays are the same size as the grid.
! \item[{[coordDimMap]}]
! 2D list of size dimCount x dimCount. This array describes the
! map of each component array's dimensions onto the grids
! dimensions. Each entry {\tt coordDimMap(i,j)} tells which
! grid dimension component i's, jth dimension maps to.
! Note that if j is bigger than {\tt coordDimCount(i)} it is ignored.
! The default for each row i is {\tt coordDimMap(i,:)=(1,2,3,4,...)}.
! \item[{[gridEdgeLWidth]}]
! The padding around the lower edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 0, 0, ..., 0 (all zeros).
! \item[{[gridEdgeUWidth]}]
! The padding around the upper edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 1, 1, ..., 1 (all ones).
! \item[{[gridAlign]}]
! Specification of how the stagger locations should align with the cell
! index space (can be overridden by the individual staggerAligns). If
! the gridEdgeWidths are not specified than this argument
! implies the gridEdgeWidths. If the gridEdgeWidths are specified and this argument isn't
! then this argument is implied by the gridEdgeWidths.
! If this and the gridEdgeWidths are not specified, then defaults to
! -1, -1, ..., -1 (all negative ones).
! \item[{[gridMemLBound]}]
! Specifies the lower index range of the memory of every DE in this Grid.
! Only used when indexflag is {\tt ESMF\_INDEX\_USER}. May be overridden
! by staggerMemLBound.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[vm]}]
! If present, the Grid object is created on the specified
! {\tt ESMF\_VM} object. The default is to create on the VM of the
! current context.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
integer :: localrc ! local error status
type(ESMF_Grid) :: grid
integer :: nameLen
type(ESMF_InterArray) :: gridEdgeLWidthArg ! Language Interface Helper Var
type(ESMF_InterArray) :: gridEdgeUWidthArg ! Language Interface Helper Var
type(ESMF_InterArray) :: gridAlignArg ! Language Interface Helper Var
type(ESMF_InterArray) :: gridMemLBoundArg ! Language Interface Helper Var
type(ESMF_InterArray) :: distgridToGridMapArg ! Language Interface Helper Var
type(ESMF_InterArray) :: coordDimCountArg ! Language Interface Helper Var
type(ESMF_InterArray) :: coordDimMapArg ! Language Interface Helper Var
integer :: intDestroyDistgrid,intDestroyDELayout
integer, allocatable :: collocation(:)
logical :: arbSeqIndexFlag
integer :: i, deCount, distDimCount, arbDim
type(ESMF_DELayout) :: delayout
type(ESMF_Pointer) :: vmThis
logical :: actualFlag
character(ESMF_MAXSTR), dimension(2) :: callbacktest
integer, dimension(2) :: callbacktest_lens
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check init status of arguments
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_DistGridGetInit, distgrid, rc)
! Translate F90 arguments to C++ friendly form
!! name
nameLen=0
if (present(name)) then
nameLen=len_trim(name)
endif
! Must make sure the local PET is associated with an actual member
actualFlag = .true.
if (present(vm)) then
call ESMF_VMGetThis(vm, vmThis)
if (vmThis == ESMF_NULL_POINTER) then
actualFlag = .false. ! local PET is not for an actual member of Array
endif
endif
arbDim = -1 ! initialize
if (actualFlag) then
! Safe to access distgrid on local PET to get rank from input information
!! Check if the DistGrid is an arbitrary distgrid
call ESMF_DistGridGet(distgrid, delayout=delayout, dimCount=distDimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_DELayoutGet(delayout, localDECount=deCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (deCount > 0) then
allocate(collocation(distDimCount)) ! dimCount
call ESMF_DistGridGet(distgrid, collocation=collocation, rc=localrc)
do i=1,distDimCount
call ESMF_DistGridGet(distgrid, localDE=0, collocation=collocation(i), &
arbSeqIndexFlag=arbSeqIndexFlag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (arbSeqIndexFlag) arbDim = i
enddo
deallocate(collocation)
endif
endif
if (arbDim /= -1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- distgrid should not contain arbitrary sequence indices", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
!! coordTypeKind
! It doesn't look like it needs to be translated, but test to make sure
!! staggerWidths
gridEdgeLWidthArg = ESMF_InterArrayCreate(gridEdgeLWidth, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
gridEdgeUWidthArg = ESMF_InterArrayCreate(gridEdgeUWidth, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
gridAlignArg = ESMF_InterArrayCreate(gridAlign, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
gridMemLBoundArg = ESMF_InterArrayCreate(gridMemLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! distgridToGridMap
distgridToGridMapArg = ESMF_InterArrayCreate(distgridToGridMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! Description of array factorization
coordDimCountArg = ESMF_InterArrayCreate(coordDimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
coordDimMapArg = ESMF_InterArrayCreate(farray2D=coordDimMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Initialize this grid object as invalid
grid%this = ESMF_NULL_POINTER
!! Convert destroyDistGrid flag
! default to don't destroy, subroutine used to actually set flags in other creates
intDestroyDistgrid=0
intDestroyDELayout=0
! Call C++ Subroutine to do the create
call c_ESMC_gridcreatefromdistgrid(grid%this, nameLen, name, &
coordTypeKind, distgrid, distgridToGridMapArg, coordsys, &
coordDimCountArg, coordDimMapArg, &
gridEdgeLWidthArg, gridEdgeUWidthArg, gridAlignArg, gridMemLBoundArg,&
indexflag, intDestroyDistGrid, intDestroyDELayout, vm, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
#if 0
! set Attributes for some of the basic information
if (present(coordSys)) then
call c_esmc_attributesetvalue(grid%this, 'coordSys', ESMF_TYPEKIND_I4, &
1, coordSys%coordsys, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (present(coordTypeKind)) then
callbacktest(1) = "CALLBACKESMF_GridGet"
callbacktest_lens(1)=8
callbacktest_lens(2)=12
call c_esmc_attributesetcharlist(grid%this, 'coordTypeKind', ESMF_TYPEKIND_CHARACTER, &
2, callbacktest, callbacktest_lens, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (present(indexflag)) then
call c_esmc_attributesetvalue(grid%this, 'indexflag', ESMF_TYPEKIND_I4, &
1, indexflag%i_type, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
#endif
! Deallocate helper variables
call ESMF_InterArrayDestroy(gridEdgeLWidthArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(gridEdgeUWidthArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(gridAlignArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(gridMemLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(distgridToGridMapArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(coordDimCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(coordDimMapArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set return value
ESMF_GridCreateFrmDistGrid = grid
! Set init status
ESMF_INIT_SET_CREATED(ESMF_GridCreateFrmDistGrid)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreateFrmDistGrid
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreate"
!BOP
! !IROUTINE: ESMF_GridCreate - Create a Arbitrary Grid from a DistGrid
! !INTERFACE:
! Private name; call using ESMF_GridCreate()
function ESMF_GridCreateFrmDistGridArb(distgrid, &
indexArray, distDim, &
coordSys, coordTypeKind, coordDimCount, coordDimMap, &
name, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateFrmDistGridArb
!
! !ARGUMENTS:
type(ESMF_DistGrid), intent(in) :: distgrid
integer, intent(in) :: indexArray(:,:)
integer, intent(in), optional :: distDim(:)
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: coordDimCount(:)
integer, intent(in), optional :: coordDimMap(:,:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This is the lower level function to create an arbitrarily distributed {\tt ESMF\_Grid}
! object. It allows the user to fully specify the topology and index space
! (of the distributed dimensions) using the DistGrid methods and then build a grid out
! of the resulting {\tt distgrid}. The {\tt indexArray(2,dimCount)},
! argument is required to specifies the topology of the grid.
!
! The arguments are:
! \begin{description}
! \item[distgrid]
! {\tt ESMF\_DistGrid} object that describes how the array is decomposed and
! distributed over DEs.
! \item[indexArray]
! The minIndex and maxIndex array of size {\tt 2} x {\tt dimCount}
! {\tt indexArray(1,:)} is the minIndex and {\tt indexArray(2,:)} is the maxIndex
! \item[{[distDim]}]
! This array specifies which dimensions are arbitrarily distributed.
! The size of the array specifies the total distributed dimensions.
! if not specified, the default is that all dimensions will be arbitrarily
! distributed.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! For a full list of options, please see Section~\ref{const:coordsys}.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[coordDimCount]}]
! List that has dimCount elements.
! Gives the dimension of each component (e.g. x) array. This is
! to allow factorization of the coordinate arrays. If not specified
! each component is assumed to be size 1. Note, the default value is different
! from the same argument for a non-arbitrarily distributed grid.
! \item[{[coordDimMap]}]
! 2D list of size dimCount x dimCount. This array describes the
! map of each coordinate array's dimensions onto the grids
! dimensions. {\tt coordDimMap(i,j)} is the grid dimension of the jth dimension
! of the i'th coordinate array. If not specified, the default value of
! {\tt coordDimMap(i,1)} is /ESMF\_DIM\_ARB/ if the ith dimension of the grid is
! arbitrarily distributed, or {\tt i} if the ith dimension is not distributed.
! Note that if j is bigger than {\tt coordDimCount(i)} then it's ignored.
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_DIM\_ARB.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
integer :: localrc ! local error status
type(ESMF_Grid) :: grid
integer :: nameLen
type(ESMF_InterArray) :: minIndexArg ! Language Interface Helper Var
type(ESMF_InterArray) :: maxIndexArg ! Language Interface Helper Var
type(ESMF_InterArray) :: localArbIndexArg ! Language Interface Helper Var
type(ESMF_InterArray) :: distDimArg ! Language Interface Helper Var
type(ESMF_InterArray) :: coordDimCountArg ! Language Interface Helper Var
type(ESMF_InterArray) :: coordDimMapArg ! Language Interface Helper Var
integer :: intDestroyDistgrid,intDestroyDELayout
integer :: dimCount, distDimCount, undistDimCount, dimCount1
integer, pointer :: local1DIndices(:), localArbIndex(:,:), distSize(:)
integer, pointer :: undistMinIndex(:), undistMaxIndex(:)
integer, pointer :: minIndexPTile(:,:), maxIndexPTile(:,:)
integer :: tileCount, localCounts
integer, pointer :: minIndexLocal(:), maxIndexLocal(:)
logical, pointer :: isDistDim(:)
integer :: i, j, k, arbDim, ldeCount
integer, allocatable :: distDimLocal(:)
integer, allocatable :: collocation(:)
logical :: arbSeqIndexFlag
type(ESMF_DELayout) :: delayout
integer :: seqIndex, stride
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check init status of arguments
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_DistGridGetInit, distgrid, rc)
! Translate F90 arguments to C++ friendly form
!! name
nameLen=0
if (present(name)) then
nameLen=len_trim(name)
endif
!! find out grid dimension
dimCount = size(indexArray,2)
!! find out distgrid info
call ESMF_DistGridGet(distgrid, dimCount=dimCount1, tileCount=tileCount, &
delayout=delayout, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_DElayoutGet(delayout, localDeCount=ldeCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! dimCount1 should be equal or less than dimCount
if (dimCount1 > dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- distgrid dimension has to be less or equal to dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (tileCount /= 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- distgrid tile count has to be 1", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
distDimCount = dimCount - dimCount1 + 1
undistDimCount = dimCount - distDimCount
!! distDim is a 1D array of size distDimCount. The values are the
!! Grid dimensions that are arbitrarily distributed.
if (present(distDim)) then
if (size(distDim) /= distDimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- dimension of distDim has to be the same as the arbitrary distributed dim", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
!! fill minIndexLocal
allocate(minIndexLocal(dimCount), maxIndexLocal(dimCount))
do i=1,dimCount
minIndexLocal(i) = indexArray(1,i)
maxIndexLocal(i) = indexArray(2,i)
enddo
!! set distSize
allocate(distSize(distDimCount))
allocate(isDistDim(dimCount))
allocate(distDimLocal(distDimCount))
isDistDim(:) = .false.
if (present(distDim)) then
do i=1,distDimCount
distSize(i)=maxIndexLocal(distDim(i))-minIndexLocal(distDim(i))+1
isDistDim(distDim(i))=.true.
distDimLocal(i)=distDim(i)
enddo
else
do i=1,distDimCount
distSize(i)=maxIndexLocal(i)-minIndexLocal(i)+1
isDistDim(i)=.true.
distDimLocal(i)=i
enddo
endif
!! Arbitrary grid indices
minIndexArg = ESMF_InterArrayCreate(minIndexLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
maxIndexArg = ESMF_InterArrayCreate(maxIndexLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! distDim
distDimArg = ESMF_InterArrayCreate(distDimLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (ldeCount > 0) then
call ESMF_DistGridGet(distgrid,localDE=0, elementCount=localCounts, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! reconstruct the localArbIndex from local1DIndices
allocate(local1DIndices(localCounts))
call ESMF_DistGridGet(distgrid,localDE=0, seqIndexList=local1DIndices, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
localCounts = 0
allocate(local1DIndices(localCounts))
endif
!! find out the dimension
allocate(localArbIndex(localCounts,distDimCount))
!! I hope this is correct....
!! This is kind of redundant. Because if we create the grid using shapetile API, the local1DIndices
!! were calculated by the input localArbIndex and we should not need to re-calculate the localArbIndex.
!! We only need this when user creates an arbitrary grid from a distgrid. The question is (1) do we need
!! to store the localArbIndex in the Grid data structure or not? (2) shall we allow user to pass localArbIndex
!! to the ESMF_CreateGridFromDistGrid()? If we do, we have to check if the distgrid indices matches with
!! the input localArbIndex
do i=1,localCounts
!! make it 0-based first before calculations
seqIndex=local1DIndices(i)-1
do j=distDimCount, 1, -1
stride=1
do k=1, j-1
stride = stride * distSize(k)
enddo
localArbIndex(i,j) = seqIndex / stride
seqIndex = seqIndex - stride * localArbIndex(i,j)
localArbIndex(i,j) = localArbIndex(i,j) + minIndexLocal(distDimLocal(j))
enddo
enddo
localArbIndexArg = ESMF_InterArrayCreate(farray2D=localArbIndex, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! Check the non-arbitrary dimensions in DistGrid and make sure they are
!! consistent with the minIndex and maxIndex
!! First, find out which dimension in DistGrid is arbitrary
arbDim = -1
if (ldeCount > 0) then
allocate(collocation(dimCount1)) ! dimCount
call ESMF_DistGridGet(distgrid, &
collocation=collocation, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
do i=1,dimCount1
call ESMF_DistGridGet(distgrid, localDE=0, collocation=collocation(i), &
arbSeqIndexFlag=arbSeqIndexFlag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (arbSeqIndexFlag) arbDim = i
enddo
deallocate(collocation)
if (arbDim == -1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- distgrid should contain arbitrary sequence indices", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (undistDimCount /= 0) then
allocate(minIndexPTile(dimCount1,1))
allocate(maxIndexPTile(dimCount1,1))
call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, &
maxIndexPTile=maxIndexPTile, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(undistMinIndex(undistDimCount))
allocate(undistMaxIndex(undistDimCount))
k = 1
do j=1,dimCount
if (.not. isDistDim(j)) then
undistMinIndex(k) = minIndexLocal(j)
undistMaxIndex(k) = maxIndexLocal(j)
k = k+1
endif
enddo
k = 1
do i=1,dimCount1
if (arbDim /= i) then
if ((undistMinIndex(k) /= minIndexPTile(i,1)) .or. &
(undistMaxIndex(k) /= maxIndexPTile(i,1))) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- Grid min/max index does not match with DistGrid min/max index", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
k = k + 1
endif
enddo
endif
!! Description of array factorization
coordDimCountArg = ESMF_InterArrayCreate(coordDimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
coordDimMapArg = ESMF_InterArrayCreate(farray2D=coordDimMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! DEfault to don't destroy, subroutine used to set actual values in other creates
intDestroyDistgrid=0
intDestroyDELayout=0
! Initialize this grid object as invalid
grid%this = ESMF_NULL_POINTER
! Call C++ Subroutine to do the create
call c_ESMC_gridcreatedistgridarb(grid%this, nameLen, name, &
coordTypeKind, distgrid, distDimArg, arbDim, &
coordSys, coordDimCountArg, coordDimMapArg, &
minIndexArg, maxIndexArg, localArbIndexArg, localCounts, &
intDestroyDistGrid, intDestroyDELayout, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate helper variables
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
deallocate(distSize)
deallocate(isDistDim)
deallocate(distDimLocal)
deallocate(local1DIndices)
deallocate(localArbIndex)
if (undistDimCount /= 0) then
deallocate(minIndexPTile)
deallocate(maxIndexPTile)
deallocate(undistMinIndex)
deallocate(undistMaxIndex)
endif
call ESMF_InterArrayDestroy(distDimArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(minIndexArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(maxIndexArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(localArbIndexArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(coordDimCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(coordDimMapArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set return value
ESMF_GridCreateFrmDistGridArb = grid
! Set init status
ESMF_INIT_SET_CREATED(ESMF_GridCreateFrmDistGridArb)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreateFrmDistGridArb
! Find out how the corners around the centers in a SCRIP grid
! align with each other
subroutine find_corner_align(startCell,dim1,dim2,cornerX2D,cornerY2D, &
foundAlign, topCorner,topRightCorner,btmRightCorner,btmCorner,rc)
integer :: startCell
integer :: dim1,dim2
real(ESMF_KIND_R8) :: cornerX2D(:,:),cornerY2D(:,:)
logical :: foundAlign
integer :: topCorner
integer :: topRightCorner
integer :: BtmRightCorner
integer :: btmCorner
integer :: rc
integer :: i,j
real(ESMF_KIND_R8) :: tol=0.0000000001
logical :: matches
integer :: count,inPos,outPos
integer :: ip1,im1
! Init Output
foundAlign=.false.
topCorner=-1
topRightCorner=-1
BtmRightCorner=-1
btmCorner=-1
rc=ESMF_SUCCESS
! Error check inputs
if (dim1 == 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Currently can't handle a grid thats width 1 in only 1st dim", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (dim2 == 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Currently can't handle a grid thats width 1 in only 2nd dim", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! We can't find an alignment for this case, because it won't fit in the corner data
! Report that without an error, so another can be tried.
if (startCell+1 > dim1*dim2) then
foundAlign=.false.
rc=ESMF_SUCCESS ! Successfully found that we couldn't find alignment, not an error in this case
return
endif
! We can't find an alignment for this case, because it won't fit in corner data.
! Report that without an error, so another can be tried.
if (startCell+dim1 > dim1*dim2) then
foundAlign=.false.
rc=ESMF_SUCCESS ! Successfully found that we couldn't find alignment, not an error in this case
return
endif
! We can't find an alignment for this case, because it won't fit in corner data.
! Report that without an error, so another can be tried.
if (startCell+dim1+1 > dim1*dim2) then
foundAlign=.false.
rc=ESMF_SUCCESS ! Successfully found that we couldn't find alignment, not an error in this case
return
endif
! Figure out which corner indice is the top row of corners
! It won't match any of the neighbors corners
TopCorner=-1
do i=1,4
! See if it matches nbr to the right
matches=.false.
do j=1,4
if ((abs(cornerX2D(i,startCell)-cornerX2D(j,startCell+1))<tol) .and. &
(abs(cornerY2D(i,startCell)-cornerY2D(j,startCell+1))<tol)) then
matches=.true.
exit
endif
enddo
if (matches) cycle
! See if it matches nbr to the below
matches=.false.
do j=1,4
if ((abs(cornerX2D(i,startCell)-cornerX2D(j,startCell+dim1))<tol) .and. &
(abs(cornerY2D(i,startCell)-cornerY2D(j,startCell+dim1))<tol)) then
matches=.true.
exit
endif
enddo
if (matches) cycle
! See if it matches nbr to the below and to the right
matches=.false.
do j=1,4
if ((abs(cornerX2D(i,startCell)-cornerX2D(j,startCell+dim1+1))<tol) .and. &
(abs(cornerY2D(i,startCell)-cornerY2D(j,startCell+dim1+1))<tol)) then
matches=.true.
exit
endif
enddo
if (matches) cycle
! Doesn't match anyone
TopCorner=i
! Exit the loop
exit
enddo
! Make sure we found a corner
if (TopCorner == -1) then
foundAlign=.false.
rc=ESMF_SUCCESS ! Successfully found that we couldn't find alignment, not an error in this case
return
endif
! Figure out which corner indice is the top right row of corners
! It will match the top right, but not the bottom right
TopRightCorner=-1
do i=1,4
! See if it matches nbr to the right
matches=.false.
do j=1,4
if ((abs(cornerX2D(i,startCell)-cornerX2D(j,startCell+1))<tol) .and. &
(abs(cornerY2D(i,startCell)-cornerY2D(j,startCell+1))<tol)) then
matches=.true.
exit
endif
enddo
if (.not. matches) cycle
! See if it matches nbr to the below right
matches=.false.
do j=1,4
if ((abs(cornerX2D(i,startCell)-cornerX2D(j,startCell+dim1+1))<tol) .and. &
(abs(cornerY2D(i,startCell)-cornerY2D(j,startCell+dim1+1))<tol)) then
matches=.true.
exit
endif
enddo
! correct matching so should be BtmCorner
if (.not. matches) then
TopRightCorner=i
exit
endif
enddo
! Make sure we found a corner
if (TopRightCorner == -1) then
foundAlign=.false.
rc=ESMF_SUCCESS ! Successfully found that we couldn't find alignment, not an error in this case
return
endif
! Figure out which corner indice is the bottom row of corners
! It will match the one below , but not the one to the right
BtmCorner=-1
do i=1,4
! See if it matches nbr to the right
matches=.false.
do j=1,4
if ((abs(cornerX2D(i,startCell)-cornerX2D(j,startCell+1))<tol) .and. &
(abs(cornerY2D(i,startCell)-cornerY2D(j,startCell+1))<tol)) then
matches=.true.
exit
endif
enddo
if (matches) cycle
! See if it matches nbr to the below
matches=.false.
do j=1,4
if ((abs(cornerX2D(i,startCell)-cornerX2D(j,startCell+dim1))<tol) .and. &
(abs(cornerY2D(i,startCell)-cornerY2D(j,startCell+dim1))<tol)) then
matches=.true.
exit
endif
enddo
! correct matching so should be BtmCorner
if (matches) then
BtmCorner=i
exit
endif
enddo
! Make sure we found a corner
if (BtmCorner == -1) then
foundAlign=.false.
rc=ESMF_SUCCESS ! Successfully found that we couldn't find alignment, not an error in this case
return
endif
! Figure out which corner indice is the bottom right row of corners
! It will match the bottom right, but not the top right
BtmRightCorner=-1
do i=1,4
! eliminate all other possibilities
if (i == TopCorner) cycle
if (i == TopRightCorner) cycle
if (i == BtmCorner) cycle
BtmRightCorner=i
enddo
! Make sure we found a corner
if (BtmRightCorner == -1) then
foundAlign=.false.
rc=ESMF_SUCCESS ! Successfully found that we couldn't find alignment, not an error in this case
return
endif
! Made it all the way through, so found align
foundAlign=.true.
! return success
rc=ESMF_SUCCESS
end subroutine find_corner_align
!-------------------------------------------------------------------------------------------
! Internal subroutine to convert the 2D corner coordinate arrays which contain all the corners
! surrounding each center point into a 1D Array without repeats.
! This assumes that all the corners are in the same order around each center
subroutine convert_corner_arrays_to_1D(isSphere,dim1,dim2,cornerX2D,cornerY2D,cornerX,cornerY, rc)
logical :: isSphere
integer :: dim1,dim2
real(ESMF_KIND_R8) :: cornerX2D(:,:),cornerY2D(:,:)
real(ESMF_KIND_R8) :: cornerX(:),cornerY(:)
integer :: rc
integer :: localrc
integer :: i,j
real(ESMF_KIND_R8) :: tol=0.0000000001
logical :: foundAlign
integer :: topCorner
integer :: topRightCorner
integer :: BtmRightCorner
integer :: btmCorner
logical :: matches
integer :: count,inPos,outPos
integer :: ip1,im1
! make sure no dimensions are 0
if ((dim1 < 1) .or. (dim2 <1)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG,msg="- Currently can't handle a grid of width <1 in a dim.", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Handle 1 width cases
if ((dim1 == 1) .and. (dim2 == 1)) then
! Put corner array into Grid in an order
! so that it'll be recoverted to a
! Mesh element in the same order
cornerX(1)=cornerX2D(1,1)
cornerY(1)=cornerY2D(1,1)
cornerX(2)=cornerX2D(2,1)
cornerY(2)=cornerY2D(2,1)
cornerX(3)=cornerX2D(4,1)
cornerY(3)=cornerY2D(4,1)
cornerX(4)=cornerX2D(3,1)
cornerY(4)=cornerY2D(3,1)
return
endif
! Find the alignment of the corners
call find_corner_align(1,dim1,dim2,cornerX2D,cornerY2D, &
foundAlign,topCorner,topRightCorner,btmRightCorner,btmCorner,rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Try second row
if (.not. foundAlign) then
call find_corner_align(1+dim1,dim1,dim2,cornerX2D,cornerY2D, &
foundAlign,topCorner,topRightCorner,btmRightCorner,btmCorner,rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
#if 0
! Debug output
write(*,*) "topCorner=",topCorner
write(*,*) "topRightCorner=",topRightCorner
write(*,*) "btmRightCorner=",btmRightCorner
write(*,*) "btmCorner=",btmCorner
#endif
! If we couldn't find an align then return error
if (.not. foundAlign) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg=" Couldn't find a consistent ordering of corners around each cell in file"// &
" to be able to arrange them into a logically rectangular Grid.", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
#if 0
! Error check corner info from file to make sure corners are consistent throughout file
if (isSphere) then
write(*,*)
write(*,*) "Error checking spherical Grid..."
! Init to starting pos
inPos=0
! Check rows up to btm row
do i=1,dim2-1
do j=1,dim1-1
inPos=inPos+1
if ((cornerX2D(TopRightCorner,inPos) .ne. cornerX2D(TopCorner,inPos+1)) .and. &
(cornerY2D(TopRightCorner,inPos) .ne. cornerY2D(TopCorner,inPos+1))) then
write(*,*) "TopRightCorner of ",inPos," doesn't match TopCorner of ",inPos+1
write(*,*) cornerX2D(TopRightCorner,inPos),cornerY2D(TopRightCorner,inPos)," .ne. ", &
cornerX2D(TopCorner,inPos+1),cornerY2D(TopCorner,inPos+1)
! stop
endif
if ((cornerX2D(BtmRightCorner,inPos) .ne. cornerX2D(BtmCorner,inPos+1)) .and. &
(cornerY2D(BtmRightCorner,inPos) .ne. cornerY2D(BtmCorner,inPos+1))) then
write(*,*) "BtmRightCorner of ",inPos," doesn't match BtmCorner of ",inPos+1
! stop
endif
if ((cornerX2D(BtmCorner,inPos) .ne. cornerX2D(TopCorner,inPos+dim1)) .and. &
(cornerY2D(BtmCorner,inPos) .ne. cornerY2D(TopCorner,inPos+dim1))) then
write(*,*) "BtmCorner of ",inPos," doesn't match TopCorner of ",inPos+dim1
! stop
endif
if ((cornerX2D(BtmRightCorner,inPos) .ne. cornerX2D(TopRightCorner,inPos+dim1)) .and. &
(cornerY2D(BtmRightCorner,inPos) .ne. cornerY2D(TopRightCorner,inPos+dim1))) then
write(*,*) "BtmRightCorner of ",inPos," doesn't match TopRightCorner of ",inPos+dim1
! stop
endif
enddo
! Check last point in row with beginning of row
inPos=inPos+1
if ((cornerX2D(TopRightCorner,inPos) .ne. cornerX2D(TopCorner,inPos-dim1+1)) .and. &
(cornerY2D(TopRightCorner,inPos) .ne. cornerY2D(TopCorner,inPos-dim1+1))) then
write(*,*) "TopRightCorner of ",inPos," doesn't match TopCorner of ",inPos-dim1+1
! stop
endif
if ((cornerX2D(BtmRightCorner,inPos) .ne. cornerX2D(BtmCorner,inPos-dim1+1)) .and. &
(cornerY2D(BtmRightCorner,inPos) .ne. cornerY2D(BtmCorner,inPos-dim1+1))) then
write(*,*) "BtmRightCorner of ",inPos," doesn't match BtmCorner of ",inPos-dim1+1
stop
endif
if ((cornerX2D(BtmCorner,inPos) .ne. cornerX2D(TopCorner,inPos+dim1)) .and. &
(cornerY2D(BtmCorner,inPos) .ne. cornerY2D(TopCorner,inPos+dim1))) then
write(*,*) "BtmCorner of ",inPos," doesn't match TopCorner of ",inPos+dim1
! stop
endif
if ((cornerX2D(BtmRightCorner,inPos) .ne. cornerX2D(TopRightCorner,inPos+dim1)) .and. &
(cornerY2D(BtmRightCorner,inPos) .ne. cornerY2D(TopRightCorner,inPos+dim1))) then
write(*,*) "BtmRightCorner of ",inPos," doesn't match TopRightCorner of ",inPos+dim1
! stop
endif
enddo
! Check bottom row
do j=1,dim1-1
inPos=inPos+1
if ((cornerX2D(TopRightCorner,inPos) .ne. cornerX2D(TopCorner,inPos+1)) .and. &
(cornerY2D(TopRightCorner,inPos) .ne. cornerY2D(TopCorner,inPos+1))) then
write(*,*) "TopRightCorner of ",inPos," doesn't match TopCorner of ",inPos+1
! stop
endif
if ((cornerX2D(BtmRightCorner,inPos) .ne. cornerX2D(BtmCorner,inPos+1)) .and. &
(cornerY2D(BtmRightCorner,inPos) .ne. cornerY2D(BtmCorner,inPos+1))) then
write(*,*) "BtmRightCorner of ",inPos," doesn't match BtmCorner of ",inPos+1
! stop
endif
enddo
! Check last point in row with beginning of row
inPos=inPos+1
if ((cornerX2D(TopRightCorner,inPos) .ne. cornerX2D(TopCorner,inPos-dim1+1)) .and. &
(cornerY2D(TopRightCorner,inPos) .ne. cornerY2D(TopCorner,inPos-dim1+1))) then
write(*,*) "TopRightCorner of ",inPos," doesn't match TopCorner of ",inPos-dim1+1
! stop
endif
if ((cornerX2D(BtmRightCorner,inPos) .ne. cornerX2D(BtmCorner,inPos-dim1+1)) .and. &
(cornerY2D(BtmRightCorner,inPos) .ne. cornerY2D(BtmCorner,inPos-dim1+1))) then
write(*,*) "BtmRightCorner of ",inPos," doesn't match BtmCorner of ",inPos-dim1+1
! stop
endif
else
! TODO: Check regional grid
endif
#endif
! Set Corner info
if (isSphere) then
count=size(cornerX2D,2)
do i=1,count
cornerX(i)=cornerX2D(TopCorner,i)
cornerY(i)=cornerY2D(TopCorner,i)
enddo
do i=1,dim1
cornerX(i+count)=cornerX2D(BtmCorner,count-dim1+i)
cornerY(i+count)=cornerY2D(BtmCorner,count-dim1+i)
enddo
else
! Set Corner info
inPos=0
outPos=0
do i=1,dim2
do j=1,dim1
inPos=inPos+1
outPos=outPos+1
cornerX(outPos)=cornerX2D(TopCorner,inPos)
cornerY(outPos)=cornerY2D(TopCorner,inPos)
enddo
outPos=outPos+1
cornerX(outPos)=cornerX2D(TopRightCorner,inPos)
cornerY(outPos)=cornerY2D(TopRightCorner,inPos)
enddo
inPos=inPos-dim1
do i=1,dim1
inPos=inPos+1
outPos=outPos+1
cornerX(outPos)=cornerX2D(BtmCorner,inPos)
cornerY(outPos)=cornerY2D(BtmCorner,inPos)
enddo
outPos=outPos+1
cornerX(outPos)=cornerX2D(BtmRightCorner,inPos)
cornerY(outPos)=cornerY2D(BtmRightCorner,inPos)
endif
! return success
rc=ESMF_SUCCESS
end subroutine convert_corner_arrays_to_1D
! Fill in the local fortran pointer and send the rest of the data to the other
! PETs in the same row of the decomposition
! input buffer is 1D for SCRIP files
subroutine pack_and_send_float(vm, bufsize, recvPets, rootPet, buffer, &
outbuffer, dims)
type(ESMF_VM) :: vm
integer :: bufsize(:)
integer :: recvPets
integer :: rootPet
real(ESMF_KIND_R8) :: buffer(:)
real(ESMF_KIND_R8) :: outbuffer(:,:)
integer :: dims(:)
integer :: xdim, start
integer :: lbnd(2), ubnd(2)
integer :: i,j,k,ii
real(ESMF_KIND_R8), pointer :: sendbuf(:)
integer :: localrc
! fill my own pointer first
lbnd = lbound(outbuffer)
ubnd = ubound(outbuffer)
xdim = ubnd(1)-lbnd(1)+1
bufsize(2)=ubnd(2)-lbnd(2)+1
do i=1,bufsize(2)
outbuffer(:, lbnd(2)+i-1) = buffer((i-1)*bufsize(1)+1 : (i-1)*bufsize(1)+xdim)
enddo
if (recvPets > 1) then
allocate(sendbuf(dims(1)*bufsize(2)))
start=xdim
do k = 1, recvPets-1
if (k>1) then
if (dims(k) /= dims(k-1)) then
deallocate(sendbuf)
allocate(sendbuf(dims(k)*bufsize(2)))
endif
endif
ii = 1
do j = 1, bufsize(2)
do i = start+1, start+dims(k)
sendbuf(ii) = buffer((j-1)*bufsize(1)+i)
ii=ii+1
enddo
enddo
call ESMF_VMSend(vm, sendbuf, dims(k)*bufsize(2), rootPet+k, rc=localrc)
start = start+dims(k)
enddo
deallocate(sendbuf)
endif
end subroutine pack_and_send_float
subroutine pack_and_send_floatR4(vm, bufsize, recvPets, rootPet, buffer, &
outbuffer, dims)
type(ESMF_VM) :: vm
integer :: bufsize(:)
integer :: recvPets
integer :: rootPet
real(ESMF_KIND_R4) :: buffer(:)
real(ESMF_KIND_R4) :: outbuffer(:,:)
integer :: dims(:)
integer :: xdim, start
integer :: lbnd(2), ubnd(2)
integer :: i,j,k,ii
real(ESMF_KIND_R4), pointer :: sendbuf(:)
integer :: localrc
! fill my own pointer first
lbnd = lbound(outbuffer)
ubnd = ubound(outbuffer)
xdim = ubnd(1)-lbnd(1)+1
bufsize(2)=ubnd(2)-lbnd(2)+1
do i=1,bufsize(2)
outbuffer(:, lbnd(2)+i-1) = buffer((i-1)*bufsize(1)+1 : (i-1)*bufsize(1)+xdim)
enddo
if (recvPets > 1) then
allocate(sendbuf(dims(1)*bufsize(2)))
start=xdim
do k = 1, recvPets-1
if (k>1) then
if (dims(k) /= dims(k-1)) then
deallocate(sendbuf)
allocate(sendbuf(dims(k)*bufsize(2)))
endif
endif
ii = 1
do j = 1, bufsize(2)
do i = start+1, start+dims(k)
sendbuf(ii) = buffer((j-1)*bufsize(1)+i)
ii=ii+1
enddo
enddo
call ESMF_VMSend(vm, sendbuf, dims(k)*bufsize(2), rootPet+k, rc=localrc)
start = start+dims(k)
enddo
deallocate(sendbuf)
endif
end subroutine pack_and_send_floatR4
! Fill in the local fortran pointer and send the rest of the data to the other
! PETs in the same row of the decomposition
! input buffer is 1D for SCRIP files
subroutine pack_and_send_int(vm, bufsize, recvPets, rootPet, buffer, &
outbuffer, dims)
type(ESMF_VM) :: vm
integer :: bufsize(:)
integer :: recvPets
integer :: rootPet
integer :: buffer(:)
integer :: outbuffer(:,:)
integer :: dims(:)
integer :: xdim, start
integer :: lbnd(2), ubnd(2)
integer :: i,j,k,ii
integer, pointer :: sendbuf(:)
integer :: localrc
! fill my own pointer first
lbnd = lbound(outbuffer)
ubnd = ubound(outbuffer)
xdim = ubnd(1)-lbnd(1)+1
bufsize(2) = ubnd(2)-lbnd(2)+1
do i=1,bufsize(2)
outbuffer(:, lbnd(2)+i-1) = buffer((i-1)*bufsize(1)+1 : (i-1)*bufsize(1)+xdim)
enddo
if (recvPets > 1) then
allocate(sendbuf(dims(1)*bufsize(2)))
start=xdim
do k = 1, recvPets-1
if (k>1) then
if (dims(k) /= dims(k-1)) then
deallocate(sendbuf)
allocate(sendbuf(dims(k)*bufsize(2)))
endif
endif
ii = 1
do j = 1, bufsize(2)
do i = start+1, start+dims(k)
sendbuf(ii) = buffer((j-1)*bufsize(1)+i)
ii=ii+1
enddo
enddo
call ESMF_VMSend(vm, sendbuf, dims(k)*bufsize(2), rootPet+k, rc=localrc)
start=start+dims(k)
enddo
deallocate(sendbuf)
endif
end subroutine pack_and_send_int
! Fill in the local fortran pointer and send the rest of the data to the other
! PETs in the same row of the decomposition
! input buffer is 2D for GridSpec files
subroutine pack_and_send_float2D(vm, bufsize, recvPets, rootPet, buffer, &
outbuffer, dims)
type(ESMF_VM) :: vm
integer :: bufsize(:)
integer :: recvPets
integer :: rootPet
real(ESMF_KIND_R8) :: buffer(:,:)
real(ESMF_KIND_R8) :: outbuffer(:,:)
integer :: dims(:)
integer :: xdim, start
integer :: lbnd(2), ubnd(2)
integer :: i,j,k,ii
real(ESMF_KIND_R8), pointer :: sendbuf(:)
integer :: localrc
! fill my own pointer first
lbnd = lbound(outbuffer)
ubnd = ubound(outbuffer)
xdim = ubnd(1)-lbnd(1)+1
bufsize(2)=ubnd(2)-lbnd(2)+1
outbuffer = buffer(1:xdim,1:bufsize(2))
if (recvPets > 1) then
allocate(sendbuf(dims(1)*bufsize(2)))
start=xdim
do k = 1, recvPets-1
if (k>1) then
if (dims(k) /= dims(k-1)) then
deallocate(sendbuf)
allocate(sendbuf(dims(k)*bufsize(2)))
endif
endif
ii = 1
do j = 1, bufsize(2)
do i = start+1, start+dims(k)
sendbuf(ii) = buffer(i,j)
ii=ii+1
enddo
enddo
call ESMF_VMSend(vm, sendbuf, dims(k)*bufsize(2), rootPet+k, rc=localrc)
start = start+dims(k)
enddo
deallocate(sendbuf)
endif
end subroutine pack_and_send_float2D
! Fill in the local fortran pointer and send the rest of the data to the other
! PETs in the same row of the decomposition
! input buffer is 2D for GridSpec files
subroutine pack_and_send_float2DR4(vm, bufsize, recvPets, rootPet, buffer, &
outbuffer, dims)
type(ESMF_VM) :: vm
integer :: bufsize(:)
integer :: recvPets
integer :: rootPet
real(ESMF_KIND_R4) :: buffer(:,:)
real(ESMF_KIND_R4) :: outbuffer(:,:)
integer :: dims(:)
integer :: xdim, start
integer :: lbnd(2), ubnd(2)
integer :: i,j,k,ii
real(ESMF_KIND_R4), pointer :: sendbuf(:)
integer :: localrc
! fill my own pointer first
lbnd = lbound(outbuffer)
ubnd = ubound(outbuffer)
xdim = ubnd(1)-lbnd(1)+1
bufsize(2)=ubnd(2)-lbnd(2)+1
outbuffer = buffer(1:xdim,1:bufsize(2))
if (recvPets > 1) then
allocate(sendbuf(dims(1)*bufsize(2)))
start=xdim
do k = 1, recvPets-1
if (k>1) then
if (dims(k) /= dims(k-1)) then
deallocate(sendbuf)
allocate(sendbuf(dims(k)*bufsize(2)))
endif
endif
ii = 1
do j = 1, bufsize(2)
do i = start+1, start+dims(k)
sendbuf(ii) = buffer(i,j)
ii=ii+1
enddo
enddo
call ESMF_VMSend(vm, sendbuf, dims(k)*bufsize(2), rootPet+k, rc=localrc)
start = start+dims(k)
enddo
deallocate(sendbuf)
endif
end subroutine pack_and_send_float2DR4
! Fill in the local integer pointer and send the rest of the data to the other
! PETs in the same row of the decomposition
! input buffer is 2D for GridSpec files
subroutine pack_and_send_int2D(vm, bufsize, recvPets, rootPet, buffer, &
outbuffer, dims)
type(ESMF_VM) :: vm
integer :: bufsize(:)
integer :: recvPets
integer :: rootPet
integer :: buffer(:,:)
integer :: outbuffer(:,:)
integer :: dims(:)
integer :: xdim, start
integer :: lbnd(2), ubnd(2)
integer :: i,j,k,ii
integer, pointer :: sendbuf(:)
integer :: localrc
! fill my own pointer first
lbnd = lbound(outbuffer)
ubnd = ubound(outbuffer)
xdim = ubnd(1)-lbnd(1)+1
bufsize(2) = ubnd(2)-lbnd(2)+1
outbuffer = buffer(1:xdim,1:bufsize(2))
if (recvPets > 1) then
allocate(sendbuf(dims(1)*bufsize(2)))
start=xdim
do k = 1, recvPets-1
if (k>1) then
if (dims(k) /= dims(k-1)) then
deallocate(sendbuf)
allocate(sendbuf(dims(k)*bufsize(2)))
endif
endif
ii = 1
do j = 1, bufsize(2)
do i = start+1, start+dims(k)
sendbuf(ii) = buffer(i,j)
ii=ii+1
enddo
enddo
call ESMF_VMSend(vm, sendbuf, dims(k)*bufsize(2), rootPet+k, rc=localrc)
start=start+dims(k)
enddo
deallocate(sendbuf)
endif
end subroutine pack_and_send_int2D
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateFrmNCFileDG"
!BOP
! !IROUTINE: ESMF_GridCreate - Create a Grid from a SCRIP or GRIDSPEC format grid file with a user specified distribution
! !INTERFACE:
! Private name; call using ESMF_GridCreate()
function ESMF_GridCreateFrmNCFileDG(filename, fileformat, distgrid, keywordEnforcer, &
isSphere, polekindflag, addCornerStagger, coordTypeKind, addUserArea, indexflag, &
addMask, varname, coordNames, rc)
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateFrmNCFileDG
!
! !ARGUMENTS:
character(len=*), intent(in) :: filename
type(ESMF_FileFormat_Flag), intent(in), optional :: fileformat
type(ESMF_DistGrid), intent(in) :: distgrid
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
logical, intent(in), optional :: isSphere
type(ESMF_PoleKind_Flag), intent(in), optional :: polekindflag(2)
logical, intent(in), optional :: addCornerStagger
type(ESMF_TypeKind_Flag),intent(in), optional :: coordTypeKind
logical, intent(in), optional :: addUserArea
type(ESMF_Index_Flag), intent(in), optional :: indexflag
logical, intent(in), optional :: addMask
character(len=*), intent(in), optional :: varname
character(len=*), intent(in), optional :: coordNames(:)
integer, intent(out), optional :: rc
! !DESCRIPTION:
! This function creates a {\tt ESMF\_Grid} object using the grid definition from
! a grid file in NetCDF that is either in the SCRIP format or in the CF convention.
! To specify the distribution, the user passes in a {\tt distGrid}.
! The grid defined in the file has to be a 2D logically rectangular grid.
! This function first call {\tt ESMF\_GridCreateFrmNCFile()} to create a {\tt ESMF\_Grid}
! object using a pre-calculated block distribution, then redistribute the Grid to
! create a new Grid object using the user specified {\tt distGrid}.
!
! This call is {\em collective} across the current VM.
!
! The arguments are:
! \begin{description}
! \item[filename]
! The NetCDF Grid filename.
! \item[{[fileformat]}]
! The file format. The valid options are {\tt ESMF\_FILEFORMAT\_SCRIP} and {\tt ESMF\_FILEFORMAT\_GRIDSPEC}.
! If it is the SCRIP format, the dimension {\tt grid\_rank} in the file has to be equal to 2.
! Please see section~\ref{const:fileformatflag} for a detailed description of the options.
! If not specified, the file type will be detected automatically.
! \item[distGrid]
! A distGrid defines how the grid is distributed
! \item[{[isSphere]}]
! If .true., create a periodic Grid. If .false., create a regional Grid. Defaults to .true.
! \item[{[polekindflag]}]
! Two item array which specifies the type of connection which occurs at the pole. The value in polekindflag(1)
! specifies the connection that occurs at the minimum end of the pole dimension. The value in polekindflag(2)
! specifies the connection that occurs at the maximum end of the pole dimension. Please see
! Section~\ref{const:polekind} for a full list of options. If not specified,
! the default is {\tt ESMF\_POLEKIND\_MONOPOLE} for both.
! \item[{[addCornerStagger]}]
! Uses the information in the grid file to add the Corner stagger to
! the Grid. The coordinates for the corner stagger is required for conservative
! regridding. If not specified, defaults to false.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. Only ESMF\_TYPEKIND\_R4
! and ESMF\_TYPEKIND\_R8 are allowed. Currently, ESMF\_TYPEKIND\_R4 is only
! supported for the GRIDSPEC fileformat.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[addUserArea]}]
! If .true., read in the cell area from the Grid file, otherwise, ESMF will calculate it. The feature
! is only supported when the grid file is in the SCRIP format. If not set, the default value is
! .false.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! section~\ref{const:indexflag} for the list of options. If not present,
! defaults to {\tt ESMF\_INDEX\_DELOCAL}.
! \item[{[addMask]}]
! If .true., generate the mask using the missing\_value attribute defined in 'varname'.
! This flag is only needed for the GRIDSPEC file format. If not set, the default value is .false.
! \item[{[varname]}]
! If addMask is true, provide a variable name stored in the grid file and
! the mask will be generated using the missing value of the data value of
! this variable. The first two dimensions of the variable has to be the
! the longitude and the latitude dimension and the mask is derived from the
! first 2D values of this variable even if this data is 3D, or 4D array.
!\item[{[coordNames]}]
! a two-element array containing the longitude and latitude variable names in a
! GRIDSPEC file if there are multiple coordinates defined in the file
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_Grid) :: grid
integer :: localrc
logical :: localIsSphere, localAddCorner
type(ESMF_Decomp_Flag) :: localDEcompFlag(2)
type(ESMF_vm) :: vm
integer :: i, PetCnt, PetNo
integer :: xpart, ypart, bigFac
integer :: xpets, ypets
integer :: xdim, ydim
integer :: srcrank
integer, pointer:: griddims(:)
type(ESMF_Index_Flag) :: localIndexFlag
type(ESMF_FileFormat_Flag) :: localFileformat
type(ESMF_TypeKind_Flag) :: localCoordTypeKind
if (present(rc)) rc=ESMF_FAILURE
call ESMF_VMGetCurrent(vm, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! set up local pet info
call ESMF_VMGet(vm, localPet=PetNo, petCount=PetCnt, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(fileformat)) then
localFileformat = fileformat
else
call ESMF_FileTypeCheck(filename, localFileformat, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (present(indexflag)) then
localIndexFlag = indexflag
else
localIndexFlag = ESMF_INDEX_DELOCAL
endif
if (present(isSphere)) then
localIsSphere = isSphere
else
localIsSphere = .true.
endif
if (present(addCornerStagger)) then
localAddCorner = AddCornerStagger
else
localAddCorner = .false.
endif
! Set Default coordTypeKind
if (present(coordTypeKind)) then
if (coordTypeKind .ne. ESMF_TYPEKIND_R4 .and. &
coordTypeKind .ne. ESMF_TYPEKIND_R8) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- only ESMF_TYPEKIND_R4 and ESMF_TYPEKIND_R8 are allowed", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
localCoordTypeKind=coordTypeKind
else
localCoordTypeKind=ESMF_TYPEKIND_R8
endif
! Only allow ESMF_TYPEKIND_R4 for GRIDSPEC filetye for now
if (localCoordTypeKind .eq. ESMF_TYPEKIND_R4 .and. &
localFileformat .ne. ESMF_FILEFORMAT_GRIDSPEC) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Currently coordTypeKind == ESMF_TYPEKIND_R4 is only supported for the GRIDSPEC format", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
allocate(griddims(2))
if (PetNo == 0) then
if (localFileformat == ESMF_FILEFORMAT_SCRIP) then
call ESMF_ScripInq(filename, grid_dims=griddims, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
elseif (localFileformat == ESMF_FILEFORMAT_GRIDSPEC) then
if (present(coordNames)) then
call ESMF_GridspecInq(filename, srcrank, griddims, coord_names=coordNames, rc=localrc)
else
call ESMF_GridspecInq(filename, srcrank, griddims, rc=localrc)
endif
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
elseif (localFileformat == ESMF_FILEFORMAT_TILE) then
! this returns the size of the center stagger, not the supergrid
call ESMF_GridSpecQueryTileSize(filename, griddims(1),griddims(2), rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
endif
call ESMF_VMBroadcast(vm, griddims, 2, 0, rc=localrc)
! Create a decomposition such that each PET will contain at least 2 column and 2 row of data
! otherwise, regrid will not work
if (PetCnt == 1) then
xpart = 1
ypart = 1
else
bigFac = 1
do i=2, int(sqrt(float(PetCnt)))
if ((PetCnt/i)*i == PetCnt) then
bigFac = i
endif
enddo
xpets = bigFac
ypets = PetCnt/xpets
if ((griddims(1) <= griddims(2) .and. xpets <= ypets) .or. &
(griddims(1) > griddims(2) .and. xpets > ypets)) then
xpart = xpets
ypart = ypets
else
xpart = ypets
ypart = xpets
endif
xdim = griddims(1)/xpart
ydim = griddims(2)/ypart
do while (xdim <= 1 .and. xpart>1)
xpart = xpart-1
xdim = griddims(1)/xpart
enddo
do while (ydim <= 1 .and. ypart>1)
ypart = ypart-1
ydim = griddims(2)/ypart
enddo
endif
deallocate(griddims)
localDEcompFlag(:) = ESMF_DECOMP_BALANCED
if (localFileformat == ESMF_FILEFORMAT_SCRIP) then
grid = ESMF_GridCreateFrmScrip(trim(filename), (/xpart,ypart/), &
localIndexFlag, decompflag=localDEcompflag, &
isSphere=localIsSphere, polekindflag=polekindflag, &
addCornerStagger=localAddCorner, &
addUserArea=addUserArea, rc=localrc)
else if (localfileformat == ESMF_FILEFORMAT_GRIDSPEC .or. &
localfileformat == ESMF_FILEFORMAT_TILE) then
! Right now, we call ESMF_GridCreateFrmGridspec() for both supergrid
! or regular CF Grid, eventually we will separate it into two routines
! Warning about user area in GridSpec
if (present(addUserArea)) then
if (addUserArea) then
call ESMF_LogWrite("ESMF does not currently support " // &
"user areas in GRIDSPEC format, so user areas will " // &
"not be used for the GRIDSPEC file.", &
ESMF_LOGMSG_WARNING, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
endif
if (present(addMask)) then
grid = ESMF_GridCreateFrmGridspec(trim(filename), (/xpart,ypart/), &
localIndexFlag, decompflag=localDEcompflag, &
isSphere=localIsSphere, polekindflag=polekindflag, &
addCornerStagger=localAddCorner, &
coordTypeKind = localCoordTypeKind, &
addMask=addMask, varname=varname, coordNames=coordNames, rc=localrc)
else
grid = ESMF_GridCreateFrmGridspec(trim(filename), (/xpart,ypart/), &
localIndexFlag, decompflag=localDEcompflag, &
isSphere=localIsSphere, polekindflag=polekindflag, &
addCornerStagger=localAddCorner, &
coordTypeKind = localCoordTypeKind, &
coordNames = coordNames, rc=localrc)
endif
else
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- The fileformat has to be either ESMF_FILEFORMAT_SCRIP or ESMF_FILEFORMAT_GRIDSPEC", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! create the final grid from intermediate grid by replacing DistGrid
ESMF_GridCreateFrmNCFileDG = ESMF_GridCreateCopyFromNewDG(grid, distGrid, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! destroy the intermediate grid
call ESMF_GridDestroy(grid, noGarbage=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(rc)) rc=ESMF_SUCCESS
return
end function ESMF_GridCreateFrmNCFileDG
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateFrmNCFile"
!BOP
!\label{API:GridCreateFrmNCFile}
! !IROUTINE: ESMF_GridCreate - Create a Grid from a SCRIP or GRIDSPEC format grid file
! !INTERFACE:
! Private name; call using ESMF_GridCreate()
function ESMF_GridCreateFrmNCFile(filename, fileformat, keywordEnforcer, regDecomp, &
decompflag, delayout, isSphere, polekindflag, addCornerStagger, coordTypeKind, &
addUserArea, indexflag, addMask, varname, coordNames, rc)
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateFrmNCFile
!
! !ARGUMENTS:
character(len=*), intent(in) :: filename
type(ESMF_FileFormat_Flag), intent(in), optional :: fileformat
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(in), optional :: regDecomp(:)
type(ESMF_Decomp_Flag), intent(in), optional :: decompflag(:)
type(ESMF_DELayout), intent(in), optional :: delayout
logical, intent(in), optional :: isSphere
type(ESMF_PoleKind_Flag), intent(in), optional :: polekindflag(2)
logical, intent(in), optional :: addCornerStagger
type(ESMF_TypeKind_Flag),intent(in), optional :: coordTypeKind
logical, intent(in), optional :: addUserArea
type(ESMF_Index_Flag), intent(in), optional :: indexflag
logical, intent(in), optional :: addMask
character(len=*), intent(in), optional :: varname
character(len=*), intent(in), optional :: coordNames(:)
integer, intent(out), optional :: rc
! !DESCRIPTION:
! This function creates a {\tt ESMF\_Grid} object using the grid definition from
! a grid file in NetCDF that is either in the SCRIP format or in the CF convention.
! To specify the distribution, the user passes in an array
! ({\tt regDecomp}) specifying the number of DEs to divide each
! dimension into. The array {\tt decompflag} indicates how the division into DEs is to
! occur. The default is to divide the range as evenly as possible.
! The grid defined in the file has to be a 2D logically rectangular
! grid.
!
! This call is {\em collective} across the current VM.
!
! The arguments are:
! \begin{description}
! \item[filename]
! The NetCDF Grid filename.
! \item[{[fileformat]}]
! The file format. The valid options are {\tt ESMF\_FILEFORMAT\_SCRIP} and {\tt ESMF\_FILEFORMAT\_GRIDSPEC}.
! If it is the SCRIP format, the dimension {\tt grid\_rank} in the file has to be equal to 2.
! Please see section~\ref{const:fileformatflag} for a detailed
! description of the options. If not specified, the filetype will be automatically detected.
! \item[{[regDecomp]}]
! A 2 element array specifying how the grid is decomposed.
! Each entry is the number of decounts for that dimension.
! The total decounts cannot exceed the total number of PETs. In other
! word, at most one DE is allowed per processor.
! If not specified, the default decomposition will be petCountx1.
! \item[{[decompflag]}]
! List of decomposition flags indicating how each dimension of the
! tile is to be divided between the DEs. The default setting
! is {\tt ESMF\_DECOMP\_BALANCED} in all dimensions. Please see
! section~\ref{const:decompflag} for a full description of the
! possible options. Note that currently the option
! {\tt ESMF\_DECOMP\_CYCLIC} isn't supported in Grid creation.
! \item[{[delayout]}]
! The DELayout that determines DE layout of DEs across PETs. The default is to create a default
! DELayout with the correct number of DEs according to the {\tt regDecomp}. See the documentation of
! the {\tt ESMF\_DELayoutCreate()} method for details about the default DELayout.
! \item[{[isSphere]}]
! If .true., create a periodic Grid. If .false., create a regional Grid. Defaults to .true.
! \item[{[polekindflag]}]
! Two item array which specifies the type of connection which occurs at the pole. The value in polekindflag(1)
! specifies the connection that occurs at the minimum end of the pole dimension. The value in polekindflag(2)
! specifies the connection that occurs at the maximum end of the pole dimension. Please see
! Section~\ref{const:polekind} for a full list of options. If not specified,
! the default is {\tt ESMF\_POLEKIND\_MONOPOLE} for both.
! \item[{[addCornerStagger]}]
! Uses the information in the grid file to add the Corner stagger to
! the Grid. The coordinates for the corner stagger is required for conservative
! regridding. If not specified, defaults to false.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. Only ESMF\_TYPEKIND\_R4
! and ESMF\_TYPEKIND\_R8 are allowed. Currently, ESMF\_TYPEKIND\_R4 is only
! supported for the GRIDSPEC fileformat.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[addUserArea]}]
! If .true., read in the cell area from the Grid file, otherwise, ESMF will calculate it. The feature
! is only supported when the grid file is in the SCRIP format. If not set, the default value is
! .false.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! section~\ref{const:indexflag} for the list of options. If not present,
! defaults to {\tt ESMF\_INDEX\_DELOCAL}.
! \item[{[addMask]}]
! If .true., generate the mask using the missing\_value attribute defined in 'varname'. This flag
! is only needed for the GRIDSPEC file format. If not set, the default value is .false.
! \item[{[varname]}]
! If addMask is true, provide a variable name stored in the grid file and
! the mask will be generated using the missing value of the data value of
! this variable. The first two dimensions of the variable has to be the
! the longitude and the latitude dimension and the mask is derived from the
! first 2D values of this variable even if this data is 3D, or 4D array.
!\item[{[coordNames]}]
! a two-element array containing the longitude and latitude variable names in a
! GRIDSPEC file if there are multiple coordinates defined in the file
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_Grid) :: grid
type(ESMF_DistGrid) :: dgOld, dgNew
integer :: localrc
logical :: localIsSphere, localAddCorner
type(ESMF_Decomp_Flag) :: localDEcompFlag(2)
integer :: regDecompLocal(2)
type(ESMF_Index_Flag) :: localIndexFlag
type(ESMF_VM) :: vm
integer :: PetCnt
type(ESMF_FileFormat_Flag) :: localFileformat
type(ESMF_TypeKind_Flag) :: localCoordTypeKind
if (present(rc)) rc=ESMF_FAILURE
! check if the total DE counts in RegDecomp is not greater than total PETs
!
call ESMF_VMGetCurrent(vm, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! set up local pet info
call ESMF_VMGet(vm, petCount=PetCnt, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(fileformat)) then
localFileformat = fileformat
else
call ESMF_FileTypeCheck(filename, localFileformat, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (present(RegDecomp)) then
if (size(RegDecomp,1) > 2) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Only 2D grid is supported in ESMF_GridCreate from file interface", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (PetCnt < RegDecomp(1)*RegDecomp(2)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- The total number of DEs cannot be greater than total processor count", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(regDecomp)) then
regDecompLocal(:)=regDecomp(:)
else
regDecompLocal(1)=PetCnt
regDecompLocal(2)=1
endif
if (present(isSphere)) then
localIsSphere = isSphere
else
localIsSphere = .true.
endif
if (present(addCornerStagger)) then
localAddCorner = AddCornerStagger
else
localAddCorner = .false.
endif
if (present(decompFlag)) then
localDEcompFlag = decompflag
else
localDEcompFlag(:) = ESMF_DECOMP_BALANCED
endif
if (present(indexflag)) then
localIndexFlag = indexflag
else
localIndexFlag = ESMF_INDEX_DELOCAL
endif
! Set Default coordTypeKind
if (present(coordTypeKind)) then
if (coordTypeKind .ne. ESMF_TYPEKIND_R4 .and. &
coordTypeKind .ne. ESMF_TYPEKIND_R8) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- only ESMF_TYPEKIND_R4 and ESMF_TYPEKIND_R8 are allowed", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
localCoordTypeKind=coordTypeKind
else
localCoordTypeKind=ESMF_TYPEKIND_R8
endif
! Only allow ESMF_TYPEKIND_R4 for GRIDSPEC filetye for now
if (localCoordTypeKind .eq. ESMF_TYPEKIND_R4 .and. &
localFileformat .ne. ESMF_FILEFORMAT_GRIDSPEC) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Currently coordTypeKind == ESMF_TYPEKIND_R4 is only supported for the GRIDSPEC format", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (localfileformat == ESMF_FILEFORMAT_SCRIP) then
grid = ESMF_GridCreateFrmScrip(trim(filename), regDecompLocal, &
localIndexFlag, decompflag=localDEcompflag, &
isSphere=localIsSphere, polekindflag=polekindflag, &
addCornerStagger=localAddCorner, &
addUserArea=addUserArea, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else if (localfileformat == ESMF_FILEFORMAT_GRIDSPEC .or. &
localfileformat == ESMF_FILEFORMAT_TILE) then
! Right now, we call ESMF_GridCreateFrmGridspec() for both supergrid
! or regular CF Grid, eventually we will separate it into two routines
! Warning about user area in GridSpec
if (present(addUserArea)) then
if (addUserArea) then
call ESMF_LogWrite("ESMF does not currently support " // &
"user areas in GRIDSPEC format, so user areas will " // &
"not be used for the GRIDSPEC file.", &
ESMF_LOGMSG_WARNING, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
endif
if (present(addMask)) then
grid = ESMF_GridCreateFrmGridspec(trim(filename), regDecompLocal, &
localIndexFlag, decompflag=localDEcompflag, &
isSphere=localIsSphere, polekindflag=polekindflag, &
addCornerStagger=localAddCorner, &
coordTypeKind = localCoordTypeKind, &
addMask=addMask, varname=varname, coordNames=coordNames, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
grid = ESMF_GridCreateFrmGridspec(trim(filename), regDecompLocal, &
localIndexFlag, decompflag=localDEcompflag, &
isSphere=localIsSphere, polekindflag=polekindflag, &
addCornerStagger=localAddCorner, &
coordTypeKind = localCoordTypeKind, &
coordNames = coordNames, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
else
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- The fileformat has to be either ESMF_FILEFORMAT_SCRIP or ESMF_FILEFORMAT_GRIDSPEC", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
ESMF_GridCreateFrmNCFile = grid
if (present(delayout)) then
! query the DistGrid from the newly created grid
call ESMF_GridGet(grid, distgrid=dgOld, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! create new DistGrid using specified DELayout
dgNew = ESMF_DistGridCreate(dgOld, delayout=delayout, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! create the final grid from intermediate grid by replacing DistGrid
ESMF_GridCreateFrmNCFile = ESMF_GridCreateCopyFromNewDG(grid, dgNew, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! destroy the intermediate grid
call ESMF_GridDestroy(grid, noGarbage=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (present(rc)) rc=ESMF_SUCCESS
return
end function ESMF_GridCreateFrmNCFile
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateFrmScrip"
!BOPI
! !IROUTINE: ESMF_GridCreateFrmScrip - Private function that create a Grid from a SRIP Grid File
function ESMF_GridCreateFrmScrip(filename, regDecomp, indexflag, keywordEnforcer, &
decompflag, isSphere, polekindflag, addCornerStagger, addUserArea, rc)
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateFrmScrip
!
! !ARGUMENTS:
character(len=*), intent(in) :: filename
integer, intent(in) :: regDecomp(:)
type(ESMF_Index_Flag), intent(in) :: Indexflag
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_Decomp_Flag), intent(in), optional :: decompflag(:)
logical, intent(in), optional :: isSphere
type(ESMF_PoleKind_Flag), intent(in), optional :: polekindflag(2)
logical, intent(in), optional :: addCornerStagger
logical, intent(in), optional :: addUserArea
integer, intent(out), optional :: rc
! !DESCRIPTION:
! This function creates a {\tt ESMF\_Grid} object using the grid definition from
! a SCRIP grid file.
! To specify the distribution, the user passes in an array
! ({\tt regDecomp}) specifying the number of DEs to divide each
! dimension into. The array {\tt decompflag} indicates how the division into DEs is to
! occur. The default is to divide the range as evenly as possible.
! The grid defined in the file has to be a 2D logically rectangular
! grid (i.e. {\tt grid\_rank} in the file needs to be 2).
!
! This call is {\em collective} across the current VM.
!
! The arguments are:
! \begin{description}
! \item[filename]
! The SCRIP Grid filename.
! \item[regDecomp]
! A 2 element array specifying how the grid is decomposed.
! Each entry is the number of decounts for that dimension.
! \item[{[decompflag]}]
! List of decomposition flags indicating how each dimension of the
! tile is to be divided between the DEs. The default setting
! is {\tt ESMF\_DECOMP\_BALANCED} in all dimensions. Please see
! Section~\ref{const:decompflag} for a full description of the
! possible options. Note that currently the option
! {\tt ESMF\_DECOMP\_CYCLIC} isn't supported in Grid creation.
! \item[{[isSphere]}]
! If .true., create a periodic Grid. If .false., create a regional Grid. Defaults to .true.
! \item[{[polekindflag]}]
! Two item array which specifies the type of connection which occurs at the pole. The value in polekindflag(1)
! specifies the connection that occurs at the minimum end of the pole dimension. The value in polekindflag(2)
! specifies the connection that occurs at the maximum end of the pole dimension. Please see
! Section~\ref{const:polekind} for a full list of options. If not specified,
! the default is {\tt ESMF\_POLEKIND\_MONOPOLE} for both.
! \item[{[addCornerStagger]}]
! Uses the information in the SCRIP file to add the Corner stagger to
! the Grid. If not specified, defaults to false.
! \item[{[addUserArea]}]
! If .true., use the cell area defined in the SCRIP file.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
#ifdef ESMF_NETCDF
integer :: ncid
integer :: ncStatus
integer :: totalpoints,totaldims
integer, pointer :: dims(:)
integer :: DimId, VarId
real(ESMF_KIND_R8), allocatable:: coordX(:),coordY(:)
real(ESMF_KIND_R8), allocatable:: area(:)
real(ESMF_KIND_R8), allocatable:: cornerX(:),cornerY(:)
real(ESMF_KIND_R8), allocatable:: cornerX2D(:,:),cornerY2D(:,:)
type(ESMF_Grid) :: grid
type(ESMF_Array) :: array
type(ESMF_VM) :: vm
integer :: numDim, buf(1), msgbuf(4)
type(ESMF_DistGrid) :: distgrid
type(ESMF_Decomp_Flag):: decompflagLocal(2)
integer :: localrc
integer :: PetNo, PetCnt
logical :: localAddCornerStagger
logical :: localAddUserArea
logical :: localIsSphere
integer :: grid_corners
integer, pointer :: minind(:,:)
integer :: cornerDims(2)
integer :: lbnd(2), ubnd(2), total(2)
real(ESMF_KIND_R8), pointer :: fptrLat(:,:), fptrLon(:,:), fptrCLon(:,:), fptrCLat(:,:)
real(ESMF_KIND_R8), pointer :: fptrArea(:,:)
integer(ESMF_KIND_I4), pointer :: fptrMask(:,:)
real(ESMF_KIND_R8), pointer :: recvbuf(:)
integer, pointer :: maskbuf(:), imask(:)
integer :: startindex
integer :: localRoot
integer :: i, j, k, ii
integer :: recv(1), centxdim, corxdim
integer :: DECount
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! get global vm information
!
call ESMF_VMGetCurrent(vm, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! set up local pet info
call ESMF_VMGet(vm, localPet=PetNo, petCount=PetCnt, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(decompFlag)) then
decompFlagLocal(:)=decompFlag(:)
else
decompFlagLocal(:)=ESMF_DECOMP_BALANCED
endif
if (present(addCornerStagger)) then
localAddCornerStagger=addCornerStagger
else
localAddCornerStagger=.false.
endif
if (present(isSphere)) then
localIsSphere=isSphere
else
localIsSphere=.true.
endif
if (present(addUserArea)) then
localAddUserArea = addUserArea
else
localAddUserArea =.false.
endif
! Get the grid rank and dimensions from the SCRIP file on PET 0, broadcast the
! data to all the PETs
allocate(dims(2))
if (PetNo == 0) then
call ESMF_ScripInq(filename, grid_dims=dims, grid_rank=totaldims, &
grid_size=totalpoints, grid_corners=grid_corners, rc=localrc)
! write(*,*) "totalpoints=",totalpoints
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! broadcast the values to other PETs
msgbuf(1)=totaldims
msgbuf(2)=dims(1)
msgbuf(3)=dims(2)
msgbuf(4)=grid_corners
call ESMF_VMBroadcast(vm, msgbuf, 4, 0, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
call ESMF_VMBroadcast(vm, msgbuf, 4, 0, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totaldims = msgbuf(1)
dims(1)=msgbuf(2)
dims(2)=msgbuf(3)
grid_corners=msgbuf(4)
endif
! if grid_rank is not equal to 2, return error
! Does SCRIP allow 3D datasets? What will be the format??
if (totaldims /= 2) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_RANK,msg="- The grip has to be 2D", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! if user wants corners and there aren't 4 then error
if (localAddCornerStagger .and. (grid_corners /= 4)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- The SCRIP file has grid_corners/=4, so can't add Grid corners", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
#if DEBUG_POLEKIND
if(present(polekindflag)) then
print *, "ESMF_GridCreateFrmScrip", polekindflag(1), polekindflag(2), localIsSphere
endif
#endif
! Create Grid based on the input distgrid
if (localIsSphere) then
grid=ESMF_GridCreate1PeriDim(minIndex=(/1,1/), maxIndex=dims, &
regDecomp=regDecomp, decompflag=decompFlagLocal, &
coordSys=ESMF_COORDSYS_SPH_DEG, &
polekindflag=polekindflag, &
gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), &
indexflag=indexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
grid=ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=dims, &
regDecomp=regDecomp, decompflag=decompFlagLocal, &
coordSys=ESMF_COORDSYS_SPH_DEG, &
gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/1,1/), &
indexflag=indexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Get the exclusive area from each PET
! Set coordinate tables
! Longitude
! Add coordinates
call ESMF_GridGet(grid, localDECount=DECount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridAddCoord(grid, staggerloc=ESMF_STAGGERLOC_CENTER, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (localAddCornerStagger) then
call ESMF_GridAddCoord(grid, staggerloc=ESMF_STAGGERLOC_CORNER, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
call ESMF_GridAddItem(grid, staggerloc=ESMF_STAGGERLOC_CENTER, &
itemflag=ESMF_GRIDITEM_MASK, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (localAddUserArea) then
call ESMF_GridAddItem(grid, staggerloc=ESMF_STAGGERLOC_CENTER, &
itemflag=ESMF_GRIDITEM_AREA, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (DECount > 0) then
! if the grid size is small enough, read the data in from PET0 and scatter the data to other PEs
! Otherwise, read in the data from the first PE in each row in deDecomp
call ESMF_GridGetCoord(grid, coordDim=1, staggerloc=ESMF_STAGGERLOC_CENTER, &
farrayPtr = fptrLon, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! need to send this information to the head PET of each row
centxdim = size(fptrLon,1)
! Latitude
call ESMF_GridGetCoord(grid, coordDim=2, staggerloc=ESMF_STAGGERLOC_CENTER, &
farrayPtr = fptrLat, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Mask
call ESMF_GridGetItem(grid, staggerloc=ESMF_STAGGERLOC_CENTER, &
itemflag=ESMF_GRIDITEM_MASK, farrayPtr = fptrMask, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Put Corners into coordinates
if (localAddCornerStagger) then
! Longitude
call ESMF_GridGetCoord(grid, staggerloc=ESMF_STAGGERLOC_CORNER, coordDim=1, &
farrayptr = fptrCLon, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! need to send this information to the head PET of each row
corxdim = size(fptrCLon,1)
! Latitude
call ESMF_GridGetCoord(grid, staggerloc=ESMF_STAGGERLOC_CORNER, coordDim=2, &
farrayptr = fptrCLat, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (localAddUserArea) then
call ESMF_GridGetItem(grid, staggerloc=ESMF_STAGGERLOC_CENTER, &
itemflag=ESMF_GRIDITEM_AREA, farrayptr = fptrArea, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (mod(PetNo,regDecomp(1)) == 0) then
! read slab of data (in contiguous rows) from the first column of PETs in the regDecomp
! For instance, if there are 8 PETs and regDecomp = /4,2/, then PET 0 and PET 4 will be
! the reader, and each one will read in half of the input data.
allocate(minind(2,PetCnt))
call ESMF_GridGet(grid, distgrid=distgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_DistGridGet(distgrid, minIndexPDe=minind, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGet(grid, ESMF_STAGGERLOC_CENTER, 0, exclusiveLBound=lbnd, &
exclusiveUBound=ubnd, exclusiveCount=total, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
total(1)=dims(1)
totalpoints = total(1)*total(2)
startindex = (minind(2,PetNo+1)-1)*total(1)+minind(1,PetNo+1)
! Get the coordinate information from the SCRIP file, if in radians, convert to degrees
if (localAddCornerStagger) then ! Get centers and corners
allocate(coordX(totalpoints), coordY(totalpoints))
allocate(imask(totalpoints), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating imask", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(cornerX2D(grid_corners,totalpoints), cornerY2D(grid_corners,totalpoints))
call ESMF_ScripGetVar(filename, grid_center_lon=coordX, &
grid_center_lat=coordY, grid_corner_lon=cornerX2D, &
grid_corner_lat=cornerY2D, grid_imask=imask, &
convertToDeg=.TRUE., start = startindex, count=totalpoints, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Calc Corner Dims
cornerDims(2)=total(2)+1
if (localIsSphere) then
cornerDims(1)=dims(1)
else
cornerDims(1)=dims(1)+1
endif
allocate(cornerX(cornerDims(1)*cornerDims(2)), cornerY(cornerDims(1)*cornerDims(2)))
call convert_corner_arrays_to_1D(localIsSphere, dims(1),total(2), cornerX2D,cornerY2D, &
cornerX,cornerY, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
deallocate(cornerX2D, cornerY2D)
else ! get just centers
allocate(coordX(totalpoints), coordY(totalpoints))
allocate(imask(totalpoints),stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating imask", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ScripGetVar(filename, grid_center_lon=coordX, &
grid_center_lat=coordY, grid_imask=imask, &
convertToDeg=.TRUE., start=startindex, count=totalpoints, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
deallocate(dims, minind)
! pack the coordinate data and send it to the PETs in the same row (PET0 fills its
! own array and send data to PET1 to PET3, PET4 will send to 5 to 7, etc...)
! if there are more than 1 PET in the regdecomp(1)
! Get the xdim of the local array from all other PETS in the same row
allocate(dims(regdecomp(1)-1))
do i=1, regDecomp(1)-1
call ESMF_VMRecv(vm, recv, 1, PetNo+i)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
dims(i)=recv(1)
enddo
call pack_and_send_float(vm, total, regDecomp(1), PetNo, coordX, fptrLon, dims)
call pack_and_send_float(vm, total, regDecomp(1), PetNo, coordY, fptrLat, dims)
call pack_and_send_int(vm, total, regDecomp(1), PetNo, imask, fptrMask, dims)
deallocate(coordX, coordY)
deallocate(imask)
if (localAddUserArea) then
allocate(area(totalpoints), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating area", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ScripGetVar(filename, grid_area=area, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call pack_and_send_float(vm, total, regDecomp(1), PetNo, area, &
fptrArea, dims)
deallocate(area)
end if
! pack corner coordinates and send
if (localAddCornerStagger) then
! collect the xdim of the corner stagger array from its member PETs
do i=1, regdecomp(1)-1
call ESMF_VMRecv(vm, recv, 1, PetNo+i)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
dims(i)=recv(1)
enddo
call pack_and_send_float(vm, cornerDims, regDecomp(1), PetNo, &
cornerX, fptrCLon, dims)
call pack_and_send_float(vm, cornerDims, regDecomp(1), PetNo, &
cornerY, fptrCLat, dims)
deallocate(cornerX, cornerY)
endif
else
localroot = (PetNo/regDecomp(1))*regDecomp(1)
call ESMF_GridGet(grid, ESMF_STAGGERLOC_CENTER, 0, exclusiveLBound=lbnd, &
exclusiveUBound=ubnd, exclusiveCount=total, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(recvbuf(total(1)*total(2)))
allocate(maskbuf(total(1)*total(2)))
! First, send the xdim of the local array to the localroot
call ESMF_VMSend(vm, total, 1, localroot)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Longitude coordinates
call ESMF_VMRecv(vm, recvbuf, total(1)*total(2), localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
do i=lbnd(2),ubnd(2)
do j=lbnd(1),ubnd(1)
fptrLon(j,i) = recvbuf(k)
k=k+1
enddo
enddo
! Latitude coordinates
call ESMF_VMRecv(vm, recvbuf, total(1)*total(2), localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
do i=lbnd(2),ubnd(2)
do j=lbnd(1),ubnd(1)
fptrLat(j,i) = recvbuf(k)
k=k+1
enddo
enddo
! Mask
call ESMF_VMRecv(vm, maskbuf, total(1)*total(2), localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
do i=lbnd(2),ubnd(2)
do j=lbnd(1),ubnd(1)
fptrMask(j,i) = maskbuf(k)
k=k+1
enddo
enddo
deallocate(maskbuf)
if (localAddUserArea) then
call ESMF_VMRecv(vm, recvbuf, total(1)*total(2), localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
do i=lbnd(2),ubnd(2)
do j=lbnd(1),ubnd(1)
fptrArea(j,i) = recvbuf(k)
k=k+1
enddo
enddo
endif
deallocate(recvbuf)
if (localAddCornerStagger) then
call ESMF_GridGet(grid, ESMF_STAGGERLOC_CORNER, 0, exclusiveLBound=lbnd, &
exclusiveUBound=ubnd, exclusiveCount=total, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(recvbuf(total(1)*total(2)))
! First, send the xdim of the local array to the localroot
call ESMF_VMSend(vm, total, 1, localroot)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Longitude coordinates
call ESMF_VMRecv(vm, recvbuf, total(1)*total(2), localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
do i=lbnd(2),ubnd(2)
do j=lbnd(1),ubnd(1)
fptrCLon(j,i) = recvbuf(k)
k=k+1
enddo
enddo
! Latitude coordinates
call ESMF_VMRecv(vm, recvbuf, total(1)*total(2), localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
do i=lbnd(2),ubnd(2)
do j=lbnd(1),ubnd(1)
fptrCLat(j,i) = recvbuf(k)
k=k+1
enddo
enddo
deallocate(recvbuf)
endif
endif
deallocate(dims)
endif ! if DECount > 0
ESMF_GridCreateFrmScrip = grid
if (present(rc)) rc=ESMF_SUCCESS
return
#else
call ESMF_LogSetError(rcToCheck=ESMF_RC_LIB_NOT_PRESENT, &
msg="- ESMF_NETCDF not defined when lib was compiled", &
ESMF_CONTEXT, rcToReturn=rc)
#endif
return
end function ESMF_GridCreateFrmScrip
!------------------------------------------------------------------------------
! NetCDF formatted GridSpec regularly distributed grid support up to 4 dim.
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateFrmGridspec"
!BOPI
! !IROUTINE: ESMF_GridCreateFrmGridspec - Create a Grid from a GridSpec grid file
! with a regular distribution
! !INTERFACE:
! Private function
function ESMF_GridCreateFrmGridspec(grid_filename, &
regDecomp, indexflag, keywordEnforcer, decompflag, &
addMask, varname, coordNames, &
isSphere, polekindflag, &
addCornerStagger, coordTypeKind, rc)
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateFrmGridspec
!
! !ARGUMENTS:
character(len=*), intent(in) :: grid_filename
integer, intent(in) :: regDecomp(:)
type(ESMF_Index_Flag), intent(in) :: indexflag
type(ESMF_KeywordEnforcer), optional :: keywordEnforcer ! must use keywords below
type(ESMF_Decomp_Flag), intent(in), optional:: decompflag(:)
logical, intent(in), optional :: addMask
character(len=*), intent(in), optional :: varname
character(len=*), intent(in), optional :: coordNames(:)
type(ESMF_PoleKind_Flag), intent(in), optional :: polekindflag(2)
logical, intent(in), optional :: isSphere
logical, intent(in), optional :: addCornerStagger
type(ESMF_TypeKind_Flag),intent(in), optional :: coordTypeKind
integer, intent(out), optional :: rc
! !DESCRIPTION:
! This function creates a {\tt ESMF\_Grid} object using the grid definition from
! a GridSpec grid file.
! To specify the distribution, the user passes in an array
! ({\tt regDecomp}) specifying the number of DEs to divide each
! dimension into. The array {\tt decompflag} indicates how the division into DEs is to
! occur. The default is to divide the range as evenly as possible.
! The grid defined in the file has to be a *** GENERALIZE 2D logically rectangular
! grid (i.e. {\tt grid\_rank} in the file needs to be 2 ***).
!
! This call is {\em collective} across the current VM.
!
! The arguments are:
! \begin{description}
! \item[{[grid_filename]}]
! The GridSpec grid tile filename.
! \item[{[regDecomp]}]
! A ndims-element array specifying how the grid is decomposed.
! Each entry is the number of decounts for that dimension.
! \item[{[decompflag]}]
! List of decomposition flags indicating how each dimension of the
! tile is to be divided between the DEs. The default setting
! is {\tt ESMF\_DECOMP\_BALANCED} in all dimensions. Please see
! Section~\ref{opt:decompflag} for a full description of the
! possible options. Note that currently the option
! {\tt ESMF\_DECOMP\_CYCLIC} isn't supported in Grid creation.
! \item[{[addMask]}]
! If .true., generate the mask using the missing value defined for varname
! \item[{[varname]}]
! If addMask is true, provide a variable name stored in the grid file and
! the mask will be generated using the missing value of the data value of
! this variable. The first two dimensions of the variable has to be the
! the longitude and the latitude dimension and the mask is derived from the
! first 2D values of this variable even if this data is 3D, or 4D array.
!\item[{[coordNames]}]
! a two-element array containing the longitude and latitude variable names in a
! GRIDSPEC file if there are multiple coordinates defined in the file
! \item[{[isSphere]}]
! If .true., create a periodic Grid. If .false., create a regional Grid. Defaults to .true.
! \item[{[polekindflag]}]
! Two item array which specifies the type of connection which occurs at the pole. The value in polekindflag(1)
! specifies the connection that occurs at the minimum end of the pole dimension. The value in polekindflag(2)
! specifies the connection that occurs at the maximum end of the pole dimension. Please see
! Section~\ref{const:polekind} for a full list of options. If not specified,
! the default is {\tt ESMF\_POLEKIND\_MONOPOLE} for both.
! \item[{[addCornerStagger]}]
! Uses the information in the GridSpec file to add the Corner stagger to
! the Grid. If not specified, defaults to true (since GridSpec defaults to
! vertex-centered grids).
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. Only ESMF\_TYPEKIND\_R4
! and ESMF\_TYPEKIND\_R8 are allowed.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
#ifdef ESMF_NETCDF
integer :: gridid, mosaicid, DimId, VarId, localrc, PetNo, PetCnt, ncStatus
Integer :: dimids(2), coordids(2), gridims(2), datadims(2)
integer :: ndims
real(ESMF_KIND_R8), allocatable :: loncoord1D(:), latcoord1D(:)
real(ESMF_KIND_R8), allocatable :: loncoord2D(:,:), latcoord2D(:,:)
real(ESMF_KIND_R8), allocatable :: cornerlon2D(:,:), cornerlat2D(:,:)
real(ESMF_KIND_R8), allocatable :: cornerlon3D(:,:,:), cornerlat3D(:,:,:)
real(ESMF_KIND_R8), allocatable :: corner1D(:), corner2D(:,:)
real(ESMF_KIND_R4), allocatable :: loncoord1DR4(:), latcoord1DR4(:)
real(ESMF_KIND_R4), allocatable :: loncoord2DR4(:,:), latcoord2DR4(:,:)
real(ESMF_KIND_R4), allocatable :: cornerlon2DR4(:,:), cornerlat2DR4(:,:)
real(ESMF_KIND_R4), allocatable :: cornerlon3DR4(:,:,:), cornerlat3DR4(:,:,:)
real(ESMF_KIND_R4), allocatable :: corner1DR4(:), corner2DR4(:,:)
integer :: msgbuf(8)
type(ESMF_CommHandle) :: commHandle
integer :: localMinIndex(2), gridEdgeLWidth(2), gridEdgeUWidth(2)
type(ESMF_Grid) :: grid
type(ESMF_Array) :: array
type(ESMF_VM) :: vm
type(ESMF_DistGrid) :: distgrid
type(ESMF_Decomp_Flag):: decompflagLocal(2)
type(ESMF_StaggerLoc) :: localStaggerLoc
logical :: localAddCornerStagger, localIsSphere, localAddMask
integer, allocatable :: dims(:), dims1(:)
integer :: total(2), lbnd(2), ubnd(2), recv(1)
real(ESMF_KIND_R8), allocatable :: varBuffer(:,:), recvbuf(:)
real(ESMF_KIND_R8), pointer :: fptrlat(:,:), fptrlon(:,:)
real(ESMF_KIND_R4), allocatable :: recvbufR4(:)
real(ESMF_KIND_R4), pointer :: fptrlatR4(:,:), fptrlonR4(:,:)
integer, pointer :: fptrmask(:,:), maskbuf(:)
integer, allocatable :: mask2D(:,:)
real(ESMF_KIND_R8) :: missing_value
integer :: i,j,k,localroot
integer :: maxIndex2D(2)
integer, pointer :: minind(:,:)
type(ESMF_CoordSys_Flag) :: coordsys
character (len=256) :: units
integer :: decnt
integer, pointer :: minIndexPDe(:,:)
integer, pointer :: maxIndexPDe(:,:)
integer :: start(2), count(2)
logical :: isGlobal
logical :: isSupergrid
real(kind=ESMF_KIND_R8), pointer :: lonPtr(:,:), latPtr(:,:)
real(kind=ESMF_KIND_R4), pointer :: lonPtrR4(:,:), latPtrR4(:,:)
integer :: localDe, deCount, s
integer :: sizex, sizey
type(ESMF_StaggerLoc), allocatable :: staggerLocList(:)
type(ESMF_DELayout) :: delayout
integer, allocatable :: demap(:)
type(ESMF_TypeKind_Flag) :: localCoordTypeKind
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! get global vm information
call ESMF_VMGetCurrent(vm, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! set up local pet info
call ESMF_VMGet(vm, localPet=PetNo, petCount=PetCnt, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(decompFlag)) then
decompFlagLocal(:)=decompFlag(:)
else
decompFlagLocal(:)=ESMF_DECOMP_BALANCED
endif
if (present(addCornerStagger)) then
localAddCornerStagger=addCornerStagger
else
localAddCornerStagger=.false.
endif
if (present(isSphere)) then
localIsSphere=isSphere
else
localIsSphere=.true.
endif
localAddMask = .false.
if (present(addMask)) then
if (addMask) then
if (.not. present(varname)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- need varname argument to create mask", &
ESMF_CONTEXT, rcToReturn=rc)
return
end if
localAddMask = .true.
endif
endif
if (present(coordTypeKind)) then
if (coordTypeKind .ne. ESMF_TYPEKIND_R4 .and. &
coordTypeKind .ne. ESMF_TYPEKIND_R8) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- only ESMF_TYPEKIND_R4 and ESMF_TYPEKIND_R8 are allowed", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
localCoordTypeKind=coordTypeKind
else
localCoordTypeKind=ESMF_TYPEKIND_R8
endif
call ESMF_GridspecQueryTileFile(grid_filename, isSupergrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (isSupergrid) then
call ESMF_GridspecQueryTileSize(grid_filename, sizex, sizey, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridspecQueryTileGlobal(trim(grid_filename), isGlobal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (isGlobal) then
grid = ESMF_GridCreate1PeriDim(regDecomp, decompFlagLocal, &
minIndex=(/1,1/), maxIndex=(/sizex,sizey/), &
indexflag=indexflag, &
coordSys=ESMF_COORDSYS_SPH_DEG, &
coordTypeKind = localCoordTypeKind, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
grid = ESMF_GridCreateNoPeriDim(regDecomp, decompFlagLocal, &
minIndex=(/1,1/), maxIndex=(/sizex,sizey/), &
indexflag=indexflag, &
coordSys=ESMF_COORDSYS_SPH_DEG, &
coordTypeKind = localCoordTypeKind, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
call ESMF_GridGet(grid, distgrid=distgrid, localDECount=decnt, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
deCount = regDecomp(1)*regDecomp(2)
allocate(minIndexPDe(2,deCount), maxIndexPDe(2,deCount))
call ESMF_DistgridGet(distgrid, minIndexPDe=minIndexPDe, maxIndexPDe = maxIndexPDe, &
delayout=delayout, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(demap(0:decnt-1))
call ESMF_DELayoutGet(delayout, localDeToDeMap=demap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (localAddCornerStagger) then
allocate(staggerLocList(2))
staggerLocList(1) = ESMF_STAGGERLOC_CENTER
staggerLocList(2) = ESMF_STAGGERLOC_CORNER
else
allocate(staggerLocList(1))
staggerLocList(1) = ESMF_STAGGERLOC_CENTER
endif
do s=1, size(staggerLocList)
call ESMF_GridAddCoord(grid, staggerloc=staggerLocList(s), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (localCoordTypeKind == ESMF_TYPEKIND_R8) then
do localDe = 0,decnt-1
call ESMF_GridGetCoord(grid, coordDim=1, localDe=localDe, &
staggerloc=staggerLocList(s), farrayPtr=lonPtr, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
start(1)=minIndexPDe(1,demap(localDe)+1)
start(2)=minIndexPDe(2,demap(localDe)+1)
count=ubound(lonPtr)-lbound(lonPtr)+1
call ESMF_GridGetCoord(grid, coordDim=2, localDe=localDe, &
staggerloc=staggerLocList(s), farrayPtr=latPtr, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Generate glocal edge coordinates and local center coordinates
! need to adjust the count???
call ESMF_GridSpecReadStagger(trim(grid_filename),sizex, sizey, lonPtr, latPtr, &
staggerLoc=staggerLocList(s), &
start=start, count=count, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
else ! localCoordTypeKind == ESMF_TYPEKIND_R4
do localDe = 0,decnt-1
call ESMF_GridGetCoord(grid, coordDim=1, localDe=localDe, &
staggerloc=staggerLocList(s), farrayPtr=lonPtrR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
start(1)=minIndexPDe(1,demap(localDe)+1)
start(2)=minIndexPDe(2,demap(localDe)+1)
count=ubound(lonPtrR4)-lbound(lonPtrR4)+1
call ESMF_GridGetCoord(grid, coordDim=2, localDe=localDe, &
staggerloc=staggerLocList(s), farrayPtr=latPtrR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Generate glocal edge coordinates and local center coordinates
! need to adjust the count???
call ESMF_GridSpecReadStagger(trim(grid_filename),sizex, sizey, lonPtrR4, latPtrR4, &
staggerLoc=staggerLocList(s), &
start=start, count=count, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
endif ! localCoordTypeKind == ESMF_TYPEKIND_RR
enddo
deallocate(minIndexPDe, maxIndexPDe, demap, staggerLocList)
else ! a regular CF Grid file containing center stagger
! Get the grid rank and dimensions from the GridSpec file on PET 0, broadcast the
! data to all the PETs
if (PetNo == 0) then
call ESMF_GridspecInq(grid_filename, ndims, gridims, coord_names=coordNames, &
dimids=dimids, coordids = coordids, units=units, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! broadcast the values to other PETs (generalized)
msgbuf(1)=ndims
msgbuf(2:3) = gridims(:)
msgbuf(4:5) = coordids(:)
msgbuf(6:7) = dimids(:)
if (trim(units) .eq. 'degrees') then
msgbuf(8) = 0
coordsys = ESMF_COORDSYS_SPH_DEG
elseif (units(1:1) .eq. 'm') then
msgbuf(8) = 1
coordsys = ESMF_COORDSYS_CART
elseif (units(1:1) .eq. 'k') then
msgbuf(8) = 2
coordsys = ESMF_COORDSYS_CART
endif
call ESMF_VMBroadcast(vm, msgbuf, 8, 0, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
call ESMF_VMBroadcast(vm, msgbuf, 8, 0, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
ndims = msgbuf(1)
gridims = msgbuf(2:3)
coordids = msgbuf(4:5)
dimids = msgbuf(6:7)
if (msgbuf(8) == 0) then
units = "degrees"
coordsys = ESMF_COORDSYS_SPH_DEG
elseif (msgbuf(8) == 1) then
units = "meters"
coordsys = ESMF_COORDSYS_CART
elseif (msgbuf(8) == 2) then
units = "kilometers"
coordsys = ESMF_COORDSYS_CART
endif
endif
if (localIsSphere .and. coordsys == ESMF_COORDSYS_CART) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- A global grid cannot use Cartisian coordinates", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Create Grid based on the input distgrid
gridEdgeLWidth=(/0,0/)
if (localIsSphere) then
gridEdgeUWidth=(/0,1/)
else
gridEdgeUWidth=(/1,1/)
endif
! only parallelize the code if ndims == 2, so separate the code based on ndums
if (ndims == 1) then
if (localIsSphere) then
grid = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), maxIndex=gridims, &
regDecomp=regDecomp, &
gridEdgeLWidth=gridEdgeLWidth, gridEdgeUWidth=gridEdgeUWidth, &
polekindflag=polekindflag, &
coordDep1=(/1/), coordDep2=(/2/), &
coordSys=ESMF_COORDSYS_SPH_DEG, &
coordTypeKind = localCoordTypeKind, &
indexflag=indexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
grid = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=gridims, &
regDecomp=regDecomp, &
gridEdgeLWidth=gridEdgeLWidth, gridEdgeUWidth=gridEdgeUWidth, &
coordDep1=(/1/), coordDep2=(/2/), &
coordSys=coordsys, &
coordTypeKind = localCoordTypeKind, &
indexflag=indexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (localCoordTypeKind == ESMF_TYPEKIND_R8) then
if (PetNo == 0) then
! Get coordinate info from the GridSpec file, if in radians, convert to degrees
if (localAddCornerStagger) then
allocate(loncoord1D(gridims(1)), latcoord1D(gridims(2)))
allocate(cornerlon2D(2,gridims(1)), cornerlat2D(2, gridims(2)))
call ESMF_GridspecGetVar1D(grid_filename, coordids, loncoord1D, latcoord1D,&
cornerlon=cornerlon2D, cornerlat=cornerlat2D, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
allocate(loncoord1D(gridims(1)), latcoord1D(gridims(2)))
call ESMF_GridspecGetVar1D(grid_filename, coordids, loncoord1D, latcoord1D,&
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! convert to kilometer if the units is "meters"
if (units(1:1) .eq. 'm') then
loncoord1D(:) = loncoord1D(:) * 1.d-3
latcoord1D(:) = latcoord1D(:) * 1.d-3
if (localAddCornerStagger) then
cornerlon2D(:,:) = cornerlon2D(:,:) * 1.d-3
cornerlat2D(:,:) = cornerlat2D(:,:) * 1.d-3
endif
endif
endif
! Set coordinate tables - Put Corners into coordinates
localStaggerLoc = ESMF_STAGGERLOC_CENTER
call ESMF_GridAddCoord(grid, staggerloc=localStaggerLoc, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set longitude coordinate
call ESMF_GridGetCoord(grid, staggerloc=localStaggerLoc, coordDim=1, &
array=array, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayScatter(array, loncoord1D, rootPet=0, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set longitude coordinate
call ESMF_GridGetCoord(grid, staggerloc=localStaggerLoc, coordDim=2, &
array=array, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayScatter(array, latcoord1D, rootPet=0, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (PetNo == 0) then
deallocate(loncoord1D, latcoord1D)
endif
! Add coordinates at the corner stagger location
if (localAddCornerStagger) then
call ESMF_GridAddCoord(grid, staggerloc=ESMF_STAGGERLOC_CORNER, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Longitude
call ESMF_GridGetCoord(grid, staggerloc=ESMF_STAGGERLOC_CORNER, coordDim=1, &
array = array, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGet(grid,tile=1,staggerloc=ESMF_STAGGERLOC_CORNER, maxIndex=maxIndex2D,&
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (PetNo == 0) then
allocate(corner1D(maxIndex2D(1)))
corner1D(1:gridims(1)) = cornerlon2D(1,:)
if (maxIndex2D(1) > gridims(1)) then
corner1D(maxIndex2D(1)) = cornerlon2D(2,gridims(1))
endif
endif
call ESMF_ArrayScatter(array, corner1D, rootPet=0, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (PetNo == 0) deallocate(corner1D)
! Latitude
call ESMF_GridGetCoord(grid, staggerloc=ESMF_STAGGERLOC_CORNER, coordDim=2, &
array = array, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (PetNo == 0) then
allocate(corner1D(maxIndex2D(2)))
corner1D(1:gridims(2)) = cornerlat2D(1,:)
if (maxIndex2D(2) > gridims(2)) then
corner1D(maxIndex2D(2)) = cornerlat2D(2,gridims(2))
endif
endif
call ESMF_ArrayScatter(array, corner1D, rootPet=0, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
else ! localCoordTypeKind == ESMF_TYPEKIND_R4
if (PetNo == 0) then
! Get coordinate info from the GridSpec file, if in radians, convert to degrees
if (localAddCornerStagger) then
allocate(loncoord1DR4(gridims(1)), latcoord1DR4(gridims(2)))
allocate(cornerlon2DR4(2,gridims(1)), cornerlat2DR4(2, gridims(2)))
call ESMF_GridspecGetVar1DR4(grid_filename, coordids, loncoord1DR4, latcoord1DR4,&
cornerlon=cornerlon2DR4, cornerlat=cornerlat2DR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
allocate(loncoord1DR4(gridims(1)), latcoord1DR4(gridims(2)))
call ESMF_GridspecGetVar1DR4(grid_filename, coordids, loncoord1DR4, latcoord1DR4,&
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! convert to kilometer if the units is "meters"
if (units(1:1) .eq. 'm') then
loncoord1DR4(:) = loncoord1DR4(:) * 1.d-3
latcoord1DR4(:) = latcoord1DR4(:) * 1.d-3
if (localAddCornerStagger) then
cornerlon2DR4(:,:) = cornerlon2DR4(:,:) * 1.d-3
cornerlat2DR4(:,:) = cornerlat2DR4(:,:) * 1.d-3
endif
endif
endif
! Set coordinate tables - Put Corners into coordinates
localStaggerLoc = ESMF_STAGGERLOC_CENTER
call ESMF_GridAddCoord(grid, staggerloc=localStaggerLoc, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set longitude coordinate
call ESMF_GridGetCoord(grid, staggerloc=localStaggerLoc, coordDim=1, &
array=array, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayScatter(array, loncoord1DR4, rootPet=0, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set longitude coordinate
call ESMF_GridGetCoord(grid, staggerloc=localStaggerLoc, coordDim=2, &
array=array, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayScatter(array, latcoord1DR4, rootPet=0, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (PetNo == 0) then
deallocate(loncoord1DR4, latcoord1DR4)
endif
! Add coordinates at the corner stagger location
if (localAddCornerStagger) then
call ESMF_GridAddCoord(grid, staggerloc=ESMF_STAGGERLOC_CORNER, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Longitude
call ESMF_GridGetCoord(grid, staggerloc=ESMF_STAGGERLOC_CORNER, coordDim=1, &
array = array, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGet(grid,tile=1,staggerloc=ESMF_STAGGERLOC_CORNER, maxIndex=maxIndex2D,&
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (PetNo == 0) then
allocate(corner1DR4(maxIndex2D(1)))
corner1DR4(1:gridims(1)) = cornerlon2DR4(1,:)
if (maxIndex2D(1) > gridims(1)) then
corner1DR4(maxIndex2D(1)) = cornerlon2DR4(2,gridims(1))
endif
endif
call ESMF_ArrayScatter(array, corner1DR4, rootPet=0, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (PetNo == 0) deallocate(corner1DR4)
! Latitude
call ESMF_GridGetCoord(grid, staggerloc=ESMF_STAGGERLOC_CORNER, coordDim=2, &
array = array, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (PetNo == 0) then
allocate(corner1DR4(maxIndex2D(2)))
corner1DR4(1:gridims(2)) = cornerlat2DR4(1,:)
if (maxIndex2D(2) > gridims(2)) then
corner1DR4(maxIndex2D(2)) = cornerlat2DR4(2,gridims(2))
endif
endif
call ESMF_ArrayScatter(array, corner1DR4, rootPet=0, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif !localAddCornerStagger
endif ! localCoordTypeKind == ESMF_TYPEKIND_R8
elseif (ndims==2) then
if (localIsSphere) then
grid = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), maxIndex=gridims, &
regDecomp=regDecomp, &
gridEdgeLWidth=gridEdgeLWidth, gridEdgeUWidth=gridEdgeUWidth, &
polekindflag=polekindflag, &
coordSys=ESMF_COORDSYS_SPH_DEG, &
coordTypeKind=localCoordTypeKind, &
indexflag=indexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
grid = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=gridims, &
regDecomp=regDecomp, &
gridEdgeLWidth=gridEdgeLWidth, gridEdgeUWidth=gridEdgeUWidth, &
coordSys=coordsys, &
coordTypeKind=localCoordTypeKind, &
indexflag=indexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Add center stagger coordinates
localStaggerLoc = ESMF_STAGGERLOC_CENTER
call ESMF_GridAddCoord(grid, staggerloc=localStaggerLoc, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGet(grid, localDECount=decnt, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (localCoordTypeKind == ESMF_TYPEKIND_R8) then
if (decnt > 0) then
if ( mod(PetNo, regDecomp(1)) == 0) then
call ESMF_GridGet(grid, distgrid=distgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(minind(2,PetCnt))
call ESMF_DistGridGet(distgrid, minIndexPDe=minind, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGet(grid, ESMF_STAGGERLOC_CENTER, 0, exclusiveLBound=lbnd, &
exclusiveUBound=ubnd, exclusiveCount=total, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
total(1)=gridims(1)
allocate(loncoord2D(total(1),total(2)), latcoord2D(total(1),total(2)))
if (localAddCornerStagger) then
allocate(cornerlon3D(4,total(1),total(2)), cornerlat3D(4, total(1), total(2)))
call ESMF_GridspecGetVar2D(grid_filename, coordids, &
loncoord=loncoord2D, latcoord=latcoord2D, &
cornerlon=cornerlon3D, cornerlat=cornerlat3D, &
start=minind(:,PetNo+1), count=total, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
call ESMF_GridspecGetVar2D(grid_filename, coordids, &
loncoord=loncoord2D, latcoord=latcoord2D, &
start=minind(:,PetNo+1), count=total, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif !localAddCornerStagger
! convert to kilometer if the units is "meters"
if (units(1:1) .eq. 'm') then
loncoord2D(:,:) = loncoord2D(:,:) * 1.d-3
latcoord2D(:,:) = latcoord2D(:,:) * 1.d-3
if (localAddCornerStagger) then
cornerlon3D(:,:,:) = cornerlon3D(:,:,:) * 1.d-3
cornerlat3D(:,:,:) = cornerlat3D(:,:,:) * 1.d-3
endif
endif
endif ! mod(PetNo, regDecomp(1))==0
! Set longitude coordinate
call ESMF_GridGetCoord(grid, staggerloc=localStaggerLoc, coordDim=1, &
farrayptr=fptrlon, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set latitude coordinate
call ESMF_GridGetCoord(grid, staggerloc=localStaggerLoc, coordDim=2, &
farrayptr=fptrlat, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (mod(PetNo, regDecomp(1)) == 0) then
allocate(dims(regdecomp(1)-1))
do i=1, regDecomp(1)-1
call ESMF_VMRecv(vm, recv, 1, PetNo+i)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
dims(i)=recv(1)
enddo
call pack_and_send_float2D(vm, total, regDecomp(1), PetNo, lonCoord2D, fptrlon, dims)
call pack_and_send_float2D(vm, total, regDecomp(1), PetNo, latCoord2D, fptrlat, dims)
deallocate(loncoord2D, latcoord2D, dims)
else
localroot = (PetNo/regDecomp(1))*regDecomp(1)
call ESMF_GridGet(grid, ESMF_STAGGERLOC_CENTER, 0, exclusiveLBound=lbnd, &
exclusiveUBound=ubnd, exclusiveCount=total, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(recvbuf(total(1)*total(2)))
! First, send the xdim of the local array to the localroot
call ESMF_VMSend(vm, total, 1, localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Longitude coordinates
call ESMF_VMRecv(vm, recvbuf, total(1)*total(2), localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
do i=lbnd(2),ubnd(2)
do j=lbnd(1),ubnd(1)
fptrlon(j,i) = recvbuf(k)
k=k+1
enddo
enddo
! Latitude coordinates
call ESMF_VMRecv(vm, recvbuf, total(1)*total(2), localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
do i=lbnd(2),ubnd(2)
do j=lbnd(1),ubnd(1)
fptrlat(j,i) = recvbuf(k)
k=k+1
enddo
enddo
deallocate(recvbuf)
endif ! mod(PetNo, regDecomp(1))==0
endif !decnt > 0
! Add coordinates at the corner stagger location
if (localAddCornerStagger) then
call ESMF_GridGet(grid,tile=1,staggerloc=ESMF_STAGGERLOC_CORNER, &
maxIndex=maxIndex2D, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridAddCoord(grid, staggerloc=ESMF_STAGGERLOC_CORNER, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Longitude
call ESMF_GridGetCoord(grid, staggerloc=ESMF_STAGGERLOC_CORNER, coordDim=1, &
farrayptr = fptrlon, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Latitude
call ESMF_GridGetCoord(grid, staggerloc=ESMF_STAGGERLOC_CORNER, coordDim=2, &
farrayptr = fptrlat, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (decnt > 0) then
if (mod(PetNo, regDecomp(1)) == 0) then
! Get the x dimension of every local array
allocate(dims1(regDecomp(1)-1))
do i=1, regDecomp(1)-1
call ESMF_VMRecv(vm, recv, 1, PetNo+i)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
dims1(i)=recv(1)
enddo
call ESMF_GridGet(grid, ESMF_STAGGERLOC_CORNER, 0, exclusiveLBound=lbnd, &
exclusiveUBound=ubnd, exclusiveCount=total, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! prepare the corner coordinates for the entire slab to send to the
! member PETs, the horizontal size is the maxIndex for the corner stagger
total(1)=maxIndex2D(1)
allocate(corner2D(total(1),total(2)))
! the input cornerlon3D may be smaller than the size of corner2D, so need to
! fill the data at the right border or the bottom border (if it is the last
! row of the grid
datadims(1)=size(cornerlon3D,2)
datadims(2)=size(cornerlon3D,3)
corner2D(1:datadims(1),1:datadims(2)) = cornerlon3D(1,:,:)
if (total(1) > datadims(1)) then
corner2D(total(1), 1:datadims(2)) = cornerlon3D(2,datadims(1),:)
end if
if (total(2) > datadims(2)) then
corner2D(1:datadims(1), total(2)) = cornerlon3D(4,:,datadims(2))
end if
if (total(1) > datadims(1) .and. total(2) > datadims(2)) then
corner2D(total(1),total(2))=cornerlon3D(3, datadims(1), datadims(2))
endif
call pack_and_send_float2D(vm, total, regDecomp(1), PetNo, corner2D, fptrlon, dims1)
corner2D(1:datadims(1),1:datadims(2)) = cornerlat3D(1,:,:)
if (total(1) > datadims(1)) then
corner2D(total(1), 1:datadims(2)) = cornerlat3D(2,datadims(1),:)
end if
if (total(2) > datadims(2)) then
corner2D(1:datadims(1), total(2)) = cornerlat3D(4,:,datadims(2))
end if
if (total(1) > datadims(1) .and. total(2) > datadims(2)) then
corner2D(total(1),total(2))=cornerlat3D(3, datadims(1), datadims(2))
endif
call pack_and_send_float2D(vm, total, regDecomp(1), PetNo, corner2D, fptrlat, dims1)
deallocate(dims1, minind)
else ! mod(PetNo, regDecomp(1)) == 0
call ESMF_GridGet(grid, ESMF_STAGGERLOC_CORNER, 0, exclusiveLBound=lbnd, &
exclusiveUBound=ubnd, exclusiveCount=total, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(recvbuf(total(1)*total(2)))
! First, send the xdim of the local array to the localroot
call ESMF_VMSend(vm, total, 1, localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Longitude coordinates
call ESMF_VMRecv(vm, recvbuf, total(1)*total(2), localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
do i=lbnd(2),ubnd(2)
do j=lbnd(1),ubnd(1)
fptrlon(j,i) = recvbuf(k)
k=k+1
enddo
enddo
! Latitude coordinates
call ESMF_VMRecv(vm, recvbuf, total(1)*total(2), localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
do i=lbnd(2),ubnd(2)
do j=lbnd(1),ubnd(1)
fptrlat(j,i) = recvbuf(k)
k=k+1
enddo
enddo
deallocate(recvbuf)
endif ! end if (mod(PetNo, RegDecomp(1))==0)
endif ! decnt > 0
endif ! end if (AddCornerStagger)
else ! localCoordTypeKind == ESMF_TYPEKIND_R4
if (decnt > 0) then
if ( mod(PetNo, regDecomp(1)) == 0) then
call ESMF_GridGet(grid, distgrid=distgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(minind(2,PetCnt))
call ESMF_DistGridGet(distgrid, minIndexPDe=minind, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGet(grid, ESMF_STAGGERLOC_CENTER, 0, exclusiveLBound=lbnd, &
exclusiveUBound=ubnd, exclusiveCount=total, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
total(1)=gridims(1)
allocate(loncoord2DR4(total(1),total(2)), latcoord2DR4(total(1),total(2)))
if (localAddCornerStagger) then
allocate(cornerlon3DR4(4,total(1),total(2)), cornerlat3DR4(4, total(1), total(2)))
call ESMF_GridspecGetVar2DR4(grid_filename, coordids, &
loncoord=loncoord2DR4, latcoord=latcoord2DR4, &
cornerlon=cornerlon3DR4, cornerlat=cornerlat3DR4, &
start=minind(:,PetNo+1), count=total, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
call ESMF_GridspecGetVar2DR4(grid_filename, coordids, &
loncoord=loncoord2DR4, latcoord=latcoord2DR4, &
start=minind(:,PetNo+1), count=total, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! convert to kilometer if the units is "meters"
if (units(1:1) .eq. 'm') then
loncoord2DR4(:,:) = loncoord2DR4(:,:) * 1.d-3
latcoord2DR4(:,:) = latcoord2DR4(:,:) * 1.d-3
if (localAddCornerStagger) then
cornerlon3DR4(:,:,:) = cornerlon3DR4(:,:,:) * 1.d-3
cornerlat3DR4(:,:,:) = cornerlat3DR4(:,:,:) * 1.d-3
endif
endif
endif ! mod(PetNo, regDecomp(1))==0
! Set longitude coordinate
call ESMF_GridGetCoord(grid, staggerloc=localStaggerLoc, coordDim=1, &
farrayptr=fptrlonR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set latitude coordinate
call ESMF_GridGetCoord(grid, staggerloc=localStaggerLoc, coordDim=2, &
farrayptr=fptrlatR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (mod(PetNo, regDecomp(1)) == 0) then
allocate(dims(regdecomp(1)-1))
do i=1, regDecomp(1)-1
call ESMF_VMRecv(vm, recv, 1, PetNo+i)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
dims(i)=recv(1)
enddo
call pack_and_send_float2DR4(vm, total, regDecomp(1), PetNo, lonCoord2DR4, fptrlonR4, dims)
call pack_and_send_float2DR4(vm, total, regDecomp(1), PetNo, latCoord2DR4, fptrlatR4, dims)
deallocate(loncoord2DR4, latcoord2DR4, dims)
else
localroot = (PetNo/regDecomp(1))*regDecomp(1)
call ESMF_GridGet(grid, ESMF_STAGGERLOC_CENTER, 0, exclusiveLBound=lbnd, &
exclusiveUBound=ubnd, exclusiveCount=total, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(recvbufR4(total(1)*total(2)))
! First, send the xdim of the local array to the localroot
call ESMF_VMSend(vm, total, 1, localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Longitude coordinates
call ESMF_VMRecv(vm, recvbufR4, total(1)*total(2), localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
do i=lbnd(2),ubnd(2)
do j=lbnd(1),ubnd(1)
fptrlonR4(j,i) = recvbufR4(k)
k=k+1
enddo
enddo
! Latitude coordinates
call ESMF_VMRecv(vm, recvbufR4, total(1)*total(2), localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
do i=lbnd(2),ubnd(2)
do j=lbnd(1),ubnd(1)
fptrlatR4(j,i) = recvbufR4(k)
k=k+1
enddo
enddo
deallocate(recvbufR4)
endif ! end if (mod(PetNo, RegDecomp(1))==0)
endif ! decnt > 0
! Add coordinates at the corner stagger location
if (localAddCornerStagger) then
call ESMF_GridGet(grid,tile=1,staggerloc=ESMF_STAGGERLOC_CORNER, &
maxIndex=maxIndex2D, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridAddCoord(grid, staggerloc=ESMF_STAGGERLOC_CORNER, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Longitude
call ESMF_GridGetCoord(grid, staggerloc=ESMF_STAGGERLOC_CORNER, coordDim=1, &
farrayptr = fptrlonR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Latitude
call ESMF_GridGetCoord(grid, staggerloc=ESMF_STAGGERLOC_CORNER, coordDim=2, &
farrayptr = fptrlatR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (decnt > 0) then
if (mod(PetNo, regDecomp(1)) == 0) then
! Get the x dimension of every local array
allocate(dims1(regDecomp(1)-1))
do i=1, regDecomp(1)-1
call ESMF_VMRecv(vm, recv, 1, PetNo+i)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
dims1(i)=recv(1)
enddo
call ESMF_GridGet(grid, ESMF_STAGGERLOC_CORNER, 0, exclusiveLBound=lbnd, &
exclusiveUBound=ubnd, exclusiveCount=total, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! prepare the corner coordinates for the entire slab to send to the
! member PETs, the horizontal size is the maxIndex for the corner stagger
total(1)=maxIndex2D(1)
allocate(corner2DR4(total(1),total(2)))
! the input cornerlon3D may be smaller than the size of corner2D, so need to
! fill the data at the right border or the bottom border (if it is the last
! row of the grid
datadims(1)=size(cornerlon3DR4,2)
datadims(2)=size(cornerlon3DR4,3)
corner2DR4(1:datadims(1),1:datadims(2)) = cornerlon3DR4(1,:,:)
if (total(1) > datadims(1)) then
corner2DR4(total(1), 1:datadims(2)) = cornerlon3DR4(2,datadims(1),:)
end if
if (total(2) > datadims(2)) then
corner2DR4(1:datadims(1), total(2)) = cornerlon3DR4(4,:,datadims(2))
end if
if (total(1) > datadims(1) .and. total(2) > datadims(2)) then
corner2DR4(total(1),total(2))=cornerlon3DR4(3, datadims(1), datadims(2))
endif
call pack_and_send_float2DR4(vm, total, regDecomp(1), PetNo, corner2DR4, fptrlonR4, dims1)
corner2DR4(1:datadims(1),1:datadims(2)) = cornerlat3DR4(1,:,:)
if (total(1) > datadims(1)) then
corner2DR4(total(1), 1:datadims(2)) = cornerlat3DR4(2,datadims(1),:)
end if
if (total(2) > datadims(2)) then
corner2DR4(1:datadims(1), total(2)) = cornerlat3DR4(4,:,datadims(2))
end if
if (total(1) > datadims(1) .and. total(2) > datadims(2)) then
corner2DR4(total(1),total(2))=cornerlat3DR4(3, datadims(1), datadims(2))
endif
call pack_and_send_float2DR4(vm, total, regDecomp(1), PetNo, corner2DR4, fptrlatR4, dims1)
deallocate(dims1, minind)
else ! mod(PetNo, regDecomp(1))==0
call ESMF_GridGet(grid, ESMF_STAGGERLOC_CORNER, 0, exclusiveLBound=lbnd, &
exclusiveUBound=ubnd, exclusiveCount=total, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(recvbufR4(total(1)*total(2)))
! First, send the xdim of the local array to the localroot
call ESMF_VMSend(vm, total, 1, localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Longitude coordinates
call ESMF_VMRecv(vm, recvbufR4, total(1)*total(2), localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
do i=lbnd(2),ubnd(2)
do j=lbnd(1),ubnd(1)
fptrlonR4(j,i) = recvbufR4(k)
k=k+1
enddo
enddo
! Latitude coordinates
call ESMF_VMRecv(vm, recvbufR4, total(1)*total(2), localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
do i=lbnd(2),ubnd(2)
do j=lbnd(1),ubnd(1)
fptrlatR4(j,i) = recvbufR4(k)
k=k+1
enddo
enddo
deallocate(recvbufR4)
endif ! end if (mod(PetNo, RegDecomp(1))==0)
endif ! end if (decnt>0)
endif ! end if (localAddCornerStagger) then
endif ! end if (localCoordTypeKind == ESMF_TYPEKIND_R8)
endif ! end if ndims == 2
! Only add mask if localAddMask = .TRUE.
! This code is common whether it is ndims=1 or ndims=2
if (localAddMask) then
call ESMF_GridAddItem(grid, staggerloc=localStaggerLoc, &
itemflag = ESMF_GRIDITEM_MASK, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGetItem(grid, staggerloc=localStaggerLoc, &
itemflag=ESMF_GRIDITEM_MASK, farrayptr=fptrmask, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGet(grid, localStaggerLoc, 0, exclusiveLBound=lbnd, &
exclusiveUBound=ubnd, exclusiveCount=total, rc=localrc)
! Check if we want to extract mask from a data variable
if (mod(PetNo, regDecomp(1)) == 0) then
call ESMF_GridGet(grid, distgrid=distgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(minind(2,PetCnt))
call ESMF_DistGridGet(distgrid, minIndexPDe=minind, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(dims(regdecomp(1)-1))
do i=1, regDecomp(1)-1
call ESMF_VMRecv(vm, recv, 1, PetNo+i)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
dims(i)=recv(1)
enddo
call ESMF_GridGet(grid, ESMF_STAGGERLOC_CENTER, 0, exclusiveLBound=lbnd, &
exclusiveUBound=ubnd, exclusiveCount=total, rc=localrc)
total(1)=gridims(1)
allocate(varBuffer(total(1),total(2)),mask2D(total(1),total(2)))
mask2D(:,:) = 1
call ESMF_GridspecGetVarByName(grid_filename, varname, dimids, &
varBuffer, missing_value = missing_value, &
start=minind(:,PetNo+1), count=total, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
do i=1,size(varBuffer,2)
do j=1,size(varBuffer,1)
if (varBuffer(j,i) == missing_value) then
mask2D(j,i)=0
endif
enddo
enddo
call pack_and_send_int2D(vm, total, regDecomp(1), PetNo, mask2D, fptrmask, dims)
deallocate(varBuffer)
deallocate(mask2D)
deallocate(dims)
deallocate(minind)
else
call ESMF_GridGet(grid, ESMF_STAGGERLOC_CENTER, 0, exclusiveLBound=lbnd, &
exclusiveUBound=ubnd, exclusiveCount=total, rc=localrc)
localroot = (PetNo/regDecomp(1))*regDecomp(1)
! First, send the xdim of the local array to the localroot
call ESMF_VMSend(vm, total, 1, localroot)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(maskbuf(total(1)*total(2)))
call ESMF_VMRecv(vm, maskbuf, total(1)*total(2), localroot, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
do i=lbnd(2),ubnd(2)
do j=lbnd(1),ubnd(1)
fptrmask(j,i) = maskbuf(k)
k=k+1
enddo
enddo
deallocate(maskbuf)
endif
endif
endif ! if (isSuperGrid)
ESMF_GridCreateFrmGridspec = grid
if (present(rc)) rc=ESMF_SUCCESS
return
#else
call ESMF_LogSetError(rcToCheck=ESMF_RC_LIB_NOT_PRESENT, &
msg="- ESMF_NETCDF not defined when lib was compiled", &
ESMF_CONTEXT, rcToReturn=rc)
return
#endif
end function ESMF_GridCreateFrmGridspec
!------------------------------------------------------------------------------
! Begin of draft interfaces
!------------------------------------------------------------------------------
! Below are three private draft interfaces to help create a 3D Grid with both
! constant and variable layer heights for each 2D grid location:
!
! 1. ESMF_GridCreateFrmGrid - Adds one undistributed vertical dimension to
! a 2D Grid.
!
! 2. ESMF_GridCreateFrmGridCoord - Adds one undistributed, constant vertical
! coordinate (1D Fortran array) to a 2D Grid.
!
! 3. ESMF_GridCreateFrmField - Create a 3D Grid from a Field defined on a
! 2D Grid with an ungridded dimension.
! (depends on ESMF_GeomBaseMod, ESMF_FieldMod)
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateFrmGrid"
!BOPI
! !IROUTINE: ESMF_GridCreateFrmGrid - Create a 3D Grid by adding an undistributed vertical dimension to a 2D Grid
! !INTERFACE:
! Private name; call using ESMF_GridCreate() ?
function ESMF_GridCreateFrmGrid(grid, minIndex, maxIndex, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateFrmGrid
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
integer, intent(in), optional :: minIndex
integer, intent(in) :: maxIndex
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This function creates a new 3D {\tt ESMF\_Grid} object by adding an
! undistributed vertical dimension to an existing 2D {\tt ESMF\_Grid} object.
! A maximum and, optionally, a minimum value are provided by the user for
! the vertical dimension index. The coordinates from the input 2D grid are
! included in the final 3D grid, while values for the undistributed vertical
! coordinate must be set subsequently.
!
! The arguments are:
! \begin{description}
! \item[grid]
! The original 2D {\tt ESMF\_Grid} object.
! \item[{[minIndex]}]
! Minimum index value for the undistributed vertical dimension. If omitted,
! defaults to 1.
! \item[maxIndex]
! Maximum index value for the undistributed vertical dimension.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
! local variables
integer :: localrc
integer :: connectionCount, deCount, dimCount, itemCount, tileCount
integer :: ldimCount, localDe, localDeCount, minIndx
integer :: item
integer :: tileIndexA, tileIndexB
integer, dimension(:), pointer :: positionVector, orientationVector
integer, dimension(:), pointer :: newPositionVector, newOrientationVector
integer, dimension(:), allocatable :: coordDimCount, distgridToGridMap
integer, dimension(:), allocatable :: newcoordDimCount, newdistgridToGridMap
integer, dimension(:,:), allocatable :: coordDimMap, minIndexPTile, maxIndexPTile
integer, dimension(:,:), allocatable :: newcoordDimMap, newminIndexPTile, newmaxIndexPTile
real(ESMF_KIND_R8), dimension(:), pointer :: fptrIn1d, fptrOut1d
real(ESMF_KIND_R8), dimension(:,:), pointer :: fptrIn2d, fptrOut2d
type(ESMF_DistGridConnection), dimension(:), allocatable :: connectionList, newconnectionList
type(ESMF_DistGrid) :: distgrid, newdistgrid
type(ESMF_Grid) :: newgrid
type(ESMF_Index_Flag) :: indexflag
type(ESMF_CoordSys_Flag) :: coordSys
character(len=ESMF_MAXSTR) :: gridName
! begin
if (present(rc)) rc = ESMF_SUCCESS
! check additional dimension bounds
minIndx = 1
if (present(minIndex)) then
minIndx = minIndex
end if
if (maxIndex <= minIndx) then
call ESMF_LogSetError(ESMF_RC_NOT_VALID, &
msg="maxIndex must be > minIndex", &
ESMF_CONTEXT, rcToReturn=rc)
return
end if
! get grid parameters and associated DistGrid object
call ESMF_GridGet(grid, distgrid=distgrid, name=gridName, &
dimCount=dimCount, coordSys=coordSys, indexflag=indexflag, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (dimCount /= 2) then
call ESMF_LogSetError(ESMF_RC_NOT_VALID, &
msg="Grid object in field MUST have 2 dimensions", &
ESMF_CONTEXT, rcToReturn=rc)
return
end if
! get 2D distribution information from Grid's DistGrid object
allocate(coordDimCount(dimCount), &
distgridToGridMap(dimCount), &
coordDimMap(dimCount,dimCount), &
stat=localrc)
if (ESMF_LogFoundAllocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGet(grid, coordDimCount=coordDimCount, &
distgridToGridMap=distgridToGridMap, &
coordDimMap=coordDimMap, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! increment dimension count by one to build local 3D Grid
ldimCount = dimCount + 1
! create mapping arrays for 3D Grid by extending original ones from 2D Grid
allocate(newcoordDimCount(ldimCount), &
newdistgridToGridMap(ldimCount), &
newcoordDimMap(ldimCount,ldimCount), &
stat=localrc)
if (ESMF_LogFoundAllocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
newcoordDimCount(1:dimCount) = coordDimCount
newcoordDimCount(ldimCount) = 3
newdistgridToGridMap(1:dimCount) = distgridToGridMap
newdistgridToGridMap(ldimCount) = 3
newcoordDimMap(1:dimCount,1:dimCount) = coordDimMap
newcoordDimMap(:, ldimCount) = 1
newcoordDimMap(ldimCount, :) = (/ 1, 2, 3 /)
deallocate(coordDimCount, distgridToGridMap, coordDimMap, stat=localrc)
if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! in a similar fashion, extend index/tile arrays and connection settings
! for DistGrid object in new 3D Grid
! get original DistGrid information
call ESMF_DistGridGet(distgrid, &
tileCount=tileCount, connectionCount=connectionCount, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(minIndexPTile(dimCount, tileCount), &
maxIndexPTile(dimCount, tileCount), &
connectionList(connectionCount), &
stat=localrc)
if (ESMF_LogFoundAllocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! get original index arrays and connection list
call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, &
maxIndexPTile=maxIndexPTile, connectionList=connectionList, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! create new index arrays
allocate(newminIndexPTile(ldimCount, tileCount), &
newmaxIndexPTile(ldimCount, tileCount), &
stat=localrc)
if (ESMF_LogFoundAllocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
newminIndexPTile(1:dimCount,:) = minIndexPTile
newmaxIndexPTile(1:dimCount,:) = maxIndexPTile
newminIndexPTile(ldimCount, :) = minIndx
newmaxIndexPTile(ldimCount, :) = maxIndex
deallocate(minIndexPTile, maxIndexPTile, stat=localrc)
if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! extend connection list for new Grid
allocate(newConnectionList(connectionCount), &
newPositionVector(ldimCount), newOrientationVector(ldimCount), &
positionVector(dimCount), orientationVector(dimCount), &
stat=localrc)
if (ESMF_LogFoundAllocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
do item = 1, connectionCount
call ESMF_DistGridConnectionGet(connectionList(item), &
tileIndexA=tileIndexA, tileIndexB=tileIndexB, &
positionVector=positionVector, orientationVector=orientationVector, &
rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
newPositionVector(1:dimCount) = positionVector
newPositionVector( ldimCount) = 0
newOrientationVector(1:dimCount) = orientationVector
newOrientationVector( ldimCount) = 3
call ESMF_DistGridConnectionSet(newConnectionList(item), &
tileIndexA=tileIndexA, tileIndexB=tileIndexB, &
positionVector=newPositionVector, orientationVector=newOrientationVector, &
rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
end do
deallocate(newPositionVector, newOrientationVector, &
positionVector, orientationVector, connectionList, stat=localrc)
if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! create 3D DistGrid object
newdistgrid = ESMF_DistGridCreate(minIndexPTile=newminIndexPTile, &
maxIndexPTile=newmaxIndexPTile, connectionList=newConnectionList, &
rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_DistGridSet(distgrid, name="DG-GridFrom:"//trim(gridName), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
deallocate(newminIndexPTile, newmaxIndexPTile, newconnectionList, stat=localrc)
if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! create 3D Grid object
newgrid = ESMF_GridCreate(newdistgrid, coordDimCount=newcoordDimCount, &
coordDimMap=newcoordDimMap, coordSys=coordSys, indexflag=indexflag, &
name="GridFrom:"//trim(gridName), rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
deallocate(newcoordDimMap, stat=localrc)
if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! get localDeCount
call ESMF_GridGet(newgrid, localDeCount=localDeCount, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! add coordinates to 3D Grid
call ESMF_GridAddCoord(newgrid, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! load 2D coordinates
do item = 1, 2
select case (newcoordDimCount(item))
case (1)
do localDe = 0, localDeCount - 1
call ESMF_GridGetCoord(grid, coordDim=item, localDE=localDe, &
farrayPtr=fptrOut1d, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGetCoord(newgrid, coordDim=item, localDE=localDe, &
farrayPtr=fptrIn1d, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
fptrIn1d = fptrOut1d
end do
case (2)
do localDe = 0, localDeCount - 1
call ESMF_GridGetCoord(grid, coordDim=item, localDE=localDe, &
farrayPtr=fptrOut2d, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGetCoord(newgrid, coordDim=item, localDE=localDe, &
farrayPtr=fptrIn2d, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
fptrIn2d = fptrOut2d
end do
case default
call ESMF_LogSetError(ESMF_RC_INTNRL_BAD, &
msg="Internal error - should never get here!", &
ESMF_CONTEXT, rcToReturn=rc)
return
end select
end do
deallocate(newcoordDimCount, stat=localrc)
if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
ESMF_GridCreateFrmGrid = newgrid
end function ESMF_GridCreateFrmGrid
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateFrmGridCoord"
!BOPI
! !IROUTINE: ESMF_GridCreateFrmGridCoord - Create a 3D Grid from a 2D Grid and a 1D Fortran array as undistributed vertical coordinate
! !INTERFACE:
! Private name; call using ESMF_GridCreate() ?
function ESMF_GridCreateFrmGridCoord(grid, staggerloc, coord, scale, offset, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateFrmGridCoord
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type(ESMF_StaggerLoc), intent(in), optional :: staggerloc
real(ESMF_KIND_R8), intent(in) :: coord(:)
real(ESMF_KIND_R8), intent(in), optional :: scale
real(ESMF_KIND_R8), intent(in), optional :: offset
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This function creates a new 3D {\tt ESMF\_Grid} object by adding an
! undistributed vertical dimension to an existing 2D {\tt ESMF\_Grid} object,
! then setting the values of the new vertical coordinate to those provided in
! the Fortran array {\tt coord}. These values can be linearly transformed
! before being set as vertical coordinates using the optional arguments
! {\tt scale} and {\tt offset}, according the the formula:
! \begin{equation}
! \vec v' = \texttt{(scale)}\,\vec v + \texttt{offset}.
! \end{equation}
!
! The arguments are:
! \begin{description}
! \item[grid]
! The original 2D {\tt ESMF\_Grid} object.
! \item[{[staggerloc]}]
! The stagger location for the new vertical coordinate.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
! \item[coord]
! Valid native Fortran array containing the values of the undistributed vertical
! coordinate in the new 3D grid.
! \item[{[scale]}]
! Scale factor to apply to the provided {\tt coord} data.
! \item[{[offset]}]
! Offset to apply to the provided {\tt coord} data.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
! local variables
logical :: isPresent
integer :: localrc
integer :: localDe, localDeCount
integer :: k, lsize
integer :: minIndx, maxIndx
integer, dimension(3) :: lbnd, ubnd
real(ESMF_KIND_R8) :: scale_factor, add_offset
real(ESMF_KIND_R8), pointer :: fptrIn3d(:,:,:)
type(ESMF_Grid) :: newgrid
! begin
if (present(rc)) rc = ESMF_SUCCESS
newgrid = ESMF_GridCreateFrmGrid(grid, maxIndex=size(coord), rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! if staggerloc provided, check if present in new 3D grid
isPresent = .false.
call ESMF_GridGetCoord(newgrid, staggerloc=staggerloc, &
isPresent=isPresent, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (.not.isPresent) then
call ESMF_LogSetError(ESMF_RC_NOT_VALID, &
msg="This stagger location was not included in the new grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
end if
! get localDeCount
call ESMF_GridGet(newgrid, localDeCount=localDeCount, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! load vertical coordinate
scale_factor = 1._ESMF_KIND_R8
add_offset = 0._ESMF_KIND_R8
if (present(scale)) scale_factor = scale
if (present(offset)) add_offset = offset
do localDe = 0, localDeCount - 1
! get coordinate pointer from new grid
call ESMF_GridGetCoord(newgrid, coordDim=3, localDE=localDe, &
staggerloc=staggerloc, &
computationalLBound=lbnd, computationalUBound=ubnd, &
farrayPtr=fptrIn3d, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! check allocated memory size
lsize = ubnd(3)-lbnd(3)+1
if (lsize /= size(coord)) then
call ESMF_LogSetError(ESMF_RC_NOT_VALID, &
msg="size of coord array does not match internal coordinate size",&
ESMF_CONTEXT, rcToReturn=rc)
return
end if
do k = 1, lsize
fptrIn3d(lbnd(1):ubnd(1),lbnd(2):ubnd(2),k+lbnd(3)-1) = scale_factor * coord(k) + add_offset
end do
end do
ESMF_GridCreateFrmGridCoord = newgrid
end function ESMF_GridCreateFrmGridCoord
!------------------------------------------------------------------------------
#if 0
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateFrmField"
!BOPI
! !IROUTINE: ESMF_GridCreateFrmField - Create a 3D Grid from a Field defined on a 2D Grid with an ungridded dimension
! !INTERFACE:
! Private name; call using ESMF_GridCreate() ?
! NOTE: requires ESMF_GeomBaseMod, ESMF_FieldMod
function ESMF_GridCreateFrmField(field, scale, offset, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateFrmField
!
! !ARGUMENTS:
type(ESMF_Field), intent(in) :: field
real(ESMF_KIND_R8), intent(in), optional :: scale
real(ESMF_KIND_R8), intent(in), optional :: offset
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This function creates a new 3D {\tt ESMF\_Grid} object from an
! {\tt ESMF\_Field} object defined on a 2D {\tt ESMF\_Grid}. The input
! {\tt field} must have an ungridded vertical dimension, which is added
! to the associated 2D grid to create a the new 3D grid with an undistributed
! vertical coordinate. Field values can be linearly transformed before
! being used as vertical coordinates in the 3D grid. To this purpose,
! the optional arguments {\tt scale} and {\tt offset} can be used,
! according the the formula:
! \begin{equation}
! \vec f' = \texttt{(scale)}\,\vec f + \texttt{offset}.
! \end{equation}
! This is the most general method to create a 3D grid from an existing 2D grid,
! since each horizontal location can be assigned a given set of values for the
! vertical coordinate, which is specified by the values of the {\tt ESMF\_Field}
! object.
!
! The arguments are:
! \begin{description}
! \item[field]
! {\tt ESMF\_Field} object defined on a 2D {\tt ESMF\_Grid} object with an
! ungridded vertical dimension.
! \item[{[scale]}]
! Scale factor to apply to the Field values.
! \item[{[offset]}]
! Offset to apply to the Field values.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
! local variables
integer :: localrc
integer :: localDe, localDeCount
integer :: item, itemCount
integer :: ungriddedBound, vSize
real(ESMF_KIND_R8) :: scale_factor, add_offset
real(ESMF_KIND_R8), dimension(:,:,:), pointer :: fptrIn3d, fptrOut3d
type(ESMF_Grid) :: grid, newgrid
type(ESMF_FieldStatus_Flag) :: fieldStatus
type(ESMF_GeomType_Flag) :: geomtype
character(len=*), dimension(2), parameter :: &
AttributeList = (/ "UngriddedLBound", "UngriddedUBound" /)
! begin
if (present(rc)) rc = ESMF_SUCCESS
! check if field is completed
call ESMF_FieldGet(field, status=fieldStatus, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (fieldStatus /= ESMF_FIELDSTATUS_COMPLETE) then
call ESMF_LogSetError(ESMF_RC_NOT_VALID, &
msg="Field has not been completely created.", &
ESMF_CONTEXT, rcToReturn=rc)
return
end if
! check if field contains valid grid object
call ESMF_FieldGet(field, geomtype=geomtype, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (geomtype /= ESMF_GEOMTYPE_GRID) then
call ESMF_LogSetError(ESMF_RC_NOT_VALID, &
msg="No Grid object found in field ", &
ESMF_CONTEXT, rcToReturn=rc)
return
end if
! check if field has ungridded dimension
vSize = 0
do item = 1, 2
call ESMF_AttributeGet(field, name=trim(AttributeList(item)), &
convention="NUOPC", purpose="Instance", &
itemCount=itemCount, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (itemCount == 1) then
call ESMF_AttributeGet(field, name=trim(AttributeList(item)), &
convention="NUOPC", purpose="Instance", &
value=ungriddedBound, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
vSize = ungriddedBound - vSize
else
call ESMF_LogSetError(ESMF_RC_OBJ_BAD, &
msg="Field must have ONE ungridded dimension!", &
ESMF_CONTEXT, rcToReturn=rc)
return
end if
end do
vSize = vSize + 1
! create 3D grid from field's 2D grid and vertical dimension
! get original 2D grid from field
call ESMF_FieldGet(field, grid=grid, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! add vertical dimension
newgrid = ESMF_GridCreateFrmGrid(grid, minIndex=1, maxIndex=vSize, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! get new grid's localDeCount
call ESMF_GridGet(newgrid, localDeCount=localDeCount, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! -- load vertical coordinate
scale_factor = 1._ESMF_KIND_R8
add_offset = 0._ESMF_KIND_R8
if (present(scale)) scale_factor = scale
if (present(offset)) add_offset = offset
do localDe = 0, localDeCount - 1
call ESMF_FieldGet(field, localDE=localDe, farrayPtr=fptrOut3d, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGetCoord(newgrid, coordDim=3, localDE=localDe, &
staggerloc=ESMF_STAGGERLOC_CENTER, &
farrayPtr=fptrIn3d, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
fptrIn3d = scale_factor * fptrOut3d + add_offset
end do
ESMF_GridCreateFrmField = newgrid
end function ESMF_GridCreateFrmField
#endif
!------------------------------------------------------------------------------
! End of draft interfaces
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreate1PeriDimI"
!BOP
! !IROUTINE: ESMF_GridCreate1PeriDim - Create a Grid with one periodic dim and an irregular distribution
! !INTERFACE:
! Private name; call using ESMF_GridCreate1PeriDim()
function ESMF_GridCreate1PeriDimI(minIndex, &
countsPerDEDim1,countsPerDeDim2, keywordEnforcer, &
countsPerDEDim3, &
polekindflag, periodicDim, poleDim, &
coordSys, coordTypeKind, &
coordDep1, coordDep2, coordDep3, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridMemLBound, indexflag, petMap, name, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreate1PeriDimI
!
! !ARGUMENTS:
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: countsPerDEDim1(:)
integer, intent(in) :: countsPerDEDim2(:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(in), optional :: countsPerDEDim3(:)
type(ESMF_PoleKind_Flag), intent(in), optional :: polekindflag(2)
integer, intent(in), optional :: periodicDim
integer, intent(in), optional :: poleDim
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(in), optional :: gridEdgeLWidth(:)
integer, intent(in), optional :: gridEdgeUWidth(:)
integer, intent(in), optional :: gridAlign(:)
integer, intent(in), optional :: gridMemLBound(:)
type(ESMF_Index_Flag), intent(in), optional :: indexflag
integer, intent(in), optional :: petMap(:,:,:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method creates a single tile, irregularly distributed grid
! (see Figure \ref{fig:GridDecomps}) with one periodic dimension.
! To specify the irregular distribution, the user passes in an array
! for each grid dimension, where the length of the array is the number
! of DEs in the dimension. Currently this call only
! supports creating 2D or 3D Grids. A 2D Grid can be specified using the
! countsPerDEDim1 and countsPerDEDim2 arguments. A 3D Grid can
! be specified by also using the optional countsPerDEDim3 argument.
! The index of each array element in these arguments corresponds to
! a DE number. The array value at the index is the number of grid
! cells on the DE in that dimension.
!
! Section \ref{example:2DIrregUniGrid} shows an example
! of using this method to create a 2D Grid with uniformly spaced
! coordinates. This creation method can also be used as the basis for
! grids with rectilinear coordinates or curvilinear coordinates.
!
! The arguments are:
! \begin{description}
! \item[{[minIndex]}]
! Tuple to start the index ranges at. If not present, defaults
! to /1,1,1,.../.
! \item[countsPerDEDim1]
! This arrays specifies the number of cells per DE for index dimension 1
! for the exclusive region (the center stagger location).
! \item[countsPerDEDim2]
! This array specifies the number of cells per DE for index dimension 2
! for the exclusive region (center stagger location).
! \item[{[countsPerDEDim3]}]
! This array specifies the number of cells per DE for index dimension 3
! for the exclusive region (center stagger location).
! If not specified then grid is 2D.
! \item[{[polekindflag]}]
! Two item array which specifies the type of connection which occurs at the pole. The value in polekindflag(1)
! specifies the connection that occurs at the minimum end of the pole dimension. The value in polekindflag(2)
! specifies the connection that occurs at the maximum end of the pole dimension. Please see
! Section~\ref{const:polekind} for a full list of options. If not specified,
! the default is {\tt ESMF\_POLEKIND\_MONOPOLE} for both.
! \item[{[periodicDim]}]
! The periodic dimension. If not specified, defaults to 1.
! \item[{[poleDim]}]
! The dimension at who's ends the poles are located. If not specified defaults to 2.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! For a full list of options, please see Section~\ref{const:coordsys}.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[coordDep1]}]
! This array specifies the dependence of the first
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the first
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep2]}]
! This array specifies the dependence of the second
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the second
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep3]}]
! This array specifies the dependence of the third
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the third
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[gridEdgeLWidth]}]
! The padding around the lower edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 0, 0, ..., 0 (all zeros).
! \item[{[gridEdgeUWidth]}]
! The padding around the upper edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 1, 1, ..., 1 (all ones).
! \item[{[gridAlign]}]
! Specification of how the stagger locations should align with the cell
! index space (can be overridden by the individual staggerAligns). If
! the gridEdgeWidths are not specified than this argument
! implies the gridEdgeWidths. If the gridEdgeWidths are specified and this argument isn't
! then this argument is implied by the gridEdgeWidths.
! If this and the gridEdgeWidths are not specified, then defaults to
! -1, -1, ..., -1 (all negative ones).
! \item[{[gridMemLBound]}]
! Specifies the lower index range of the memory of every DE in this Grid.
! Only used when indexflag is {\tt ESMF\_INDEX\_USER}. May be overridden
! by staggerMemLBound.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[petMap]}]
! \begin{sloppypar}
! Sets the mapping of pets to the created DEs. This 3D
! should be of size size(countsPerDEDim1) x size(countsPerDEDim2) x
! size(countsPerDEDim3). If countsPerDEDim3 isn't present, then
! the last dimension is of size 1.
! \end{sloppypar}
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_DistGrid) :: distgrid
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer :: localrc
integer :: dimCount
integer, pointer :: gridEdgeLWidthLocal(:)
integer, pointer :: gridEdgeUWidthLocal(:)
integer, pointer :: gridAlignLocal(:)
integer, pointer :: minIndexLocal(:)
integer, pointer :: maxIndexLocal(:)
type(ESMF_DistgridConnection), pointer :: connList(:)
integer :: periodicDimLocal
type(ESMF_CoordSys_Flag) :: coordSysLocal
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Get the dimension and extent of the index space
call GetIndexSpaceIrreg(minIndex, &
countsPerDEDim1,countsPerDeDim2, &
countsPerDEDim3, dimCount, minIndexLocal, maxIndexLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Build connection list
call Setup1PeriodicConn(dimCount, minIndexLocal, maxIndexLocal, &
polekindflag, periodicDim, poleDim, &
connList, periodicDimLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Create Irregular distgrid and error check associated input and set defaults
distgrid=ESMF_GridCreateDistgridIrreg(dimCount, minIndexLocal, maxIndexLocal, &
countsPerDEDim1,countsPerDeDim2, &
countsPerDEDim3, indexflag, petMap, connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(name)) then
call ESMF_DistGridSet(distgrid, name="DG-"//trim(name), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Set default widths and alignment and error check
allocate(gridEdgeLWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeLWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridEdgeUWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeUWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridAlignLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridAlignLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridLUA1PeriDim(dimCount, periodicDimLocal,&
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridEdgeLWidthLocal, gridEdgeUWidthLocal, gridAlignLocal, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Convert coordDeps to coordDimCount and coordDimMap
allocate(coordDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimCount", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(coordDimMap(dimCount,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
call CoordInfoFromCoordDep(dimCount, coordDep1, coordDep2, coordDep3,&
coordDimCount, coordDimMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set Default coordSys
if (present(coordSys)) then
coordSysLocal=coordSys
else
coordSysLocal=ESMF_COORDSYS_SPH_DEG
endif
! Create Grid from specification
ESMF_GridCreate1PeriDimI=ESMF_GridCreateFrmDistGrid( &
distgrid, &
coordSys=coordSysLocal, &
coordTypeKind=coordTypeKind, &
coordDimCount=coordDimCount, coordDimMap=coordDimMap, &
gridEdgeLWidth=gridEdgeLWidthLocal, &
gridEdgeUWidth=gridEdgeUWidthLocal, &
gridAlign=gridAlignLocal, &
gridMemLBound=gridMemLBound, &
indexflag=indexflag, &
name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set internal items to be destroyed with grid
Call ESMF_GridSetDestroyDistgrid( ESMF_GridCreate1PeriDimI,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout( ESMF_GridCreate1PeriDimI,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(connList)
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
deallocate(coordDimCount)
deallocate(coordDimMap)
deallocate(gridEdgeLWidthLocal)
deallocate(gridEdgeUWidthLocal)
deallocate(gridAlignLocal)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreate1PeriDimI
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreate1PeriDimR"
!BOP
! !IROUTINE: ESMF_GridCreate1PeriDim - Create a Grid with one periodic dim and a regular distribution
! !INTERFACE:
! Private name; call using ESMF_GridCreate1PeriDim()
function ESMF_GridCreate1PeriDimR(regDecomp, decompFlag, &
minIndex, maxIndex, keywordEnforcer, &
polekindflag, periodicDim, poleDim, &
coordSys, coordTypeKind, &
coordDep1, coordDep2, coordDep3, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridMemLBound, indexflag, petMap, name, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreate1PeriDimR
!
! !ARGUMENTS:
integer, intent(in), optional :: regDecomp(:)
type(ESMF_Decomp_Flag), intent(in), optional :: decompflag(:)
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: maxIndex(:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_PoleKind_Flag), intent(in), optional :: polekindflag(2)
integer, intent(in), optional :: periodicDim
integer, intent(in), optional :: poleDim
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(in), optional :: gridEdgeLWidth(:)
integer, intent(in), optional :: gridEdgeUWidth(:)
integer, intent(in), optional :: gridAlign(:)
integer, intent(in), optional :: gridMemLBound(:)
type(ESMF_Index_Flag), intent(in), optional :: indexflag
integer, intent(in), optional :: petMap(:,:,:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method creates a single tile, regularly distributed grid
! (see Figure \ref{fig:GridDecomps}) with one periodic dimension.
! To specify the distribution, the user passes in an array
! ({\tt regDecomp}) specifying the number of DEs to divide each
! dimension into. The array {\tt decompFlag} indicates how the division into DEs is to
! occur. The default is to divide the range as evenly as possible. Currently this call
! only supports creating a 2D or 3D Grid, and thus, for example, {\tt maxIndex} must be of size 2 or 3.
!
! The arguments are:
! \begin{description}
! \item[{[regDecomp]}]
! List that has the same number of elements as {\tt maxIndex}.
! Each entry is the number of decounts for that dimension.
! If not specified, the default decomposition will be petCountx1x1..x1.
! \item[{[decompflag]}]
! List of decomposition flags indicating how each dimension of the
! tile is to be divided between the DEs. The default setting
! is {\tt ESMF\_DECOMP\_BALANCED} in all dimensions. Please see
! Section~\ref{const:decompflag} for a full description of the
! possible options. Note that currently the option
! {\tt ESMF\_DECOMP\_CYCLIC} isn't supported in Grid creation.
! \item[{[minIndex]}]
! The bottom extent of the grid array. If not given then the value defaults
! to /1,1,1,.../.
! \item[maxIndex]
! The upper extent of the grid array.
! \item[{[polekindflag]}]
! Two item array which specifies the type of connection which occurs at the pole. The value in polekindflag(1)
! specifies the connection that occurs at the minimum end of the pole dimension. The value in polekindflag(2)
! specifies the connection that occurs at the maximum end of the pole dimension. Please see
! Section~\ref{const:polekind} for a full list of options. If not specified,
! the default is {\tt ESMF\_POLEKIND\_MONOPOLE} for both.
! \item[{[periodicDim]}]
! The periodic dimension. If not specified, defaults to 1.
! \item[{[poleDim]}]
! The dimension at who's ends the poles are located. If not specified defaults to 2.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! For a full list of options, please see Section~\ref{const:coordsys}.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[coordDep1]}]
! This array specifies the dependence of the first
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the first
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep2]}]
! This array specifies the dependence of the second
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the second
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep3]}]
! This array specifies the dependence of the third
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the third
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[gridEdgeLWidth]}]
! The padding around the lower edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 0, 0, ..., 0 (all zeros).
! \item[{[gridEdgeUWidth]}]
! The padding around the upper edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 1, 1, ..., 1 (all ones).
! \item[{[gridAlign]}]
! Specification of how the stagger locations should align with the cell
! index space (can be overridden by the individual staggerAligns). If
! the gridEdgeWidths are not specified than this argument
! implies the gridEdgeWidths. If the gridEdgeWidths are specified and this argument isn't
! then this argument is implied by the gridEdgeWidths.
! If this and the gridEdgeWidths are not specified, then defaults to
! -1, -1, ..., -1 (all negative ones).
! \item[{[gridMemLBound]}]
! Specifies the lower index range of the memory of every DE in this Grid.
! Only used when indexflag is {\tt ESMF\_INDEX\_USER}. May be overridden
! by staggerMemLBound.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[petMap]}]
! Sets the mapping of pets to the created DEs. This 3D
! should be of size regDecomp(1) x regDecomp(2) x regDecomp(3)
! If the Grid is 2D, then the last dimension is of size 1.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_DistGrid) :: distgrid
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer, pointer :: gridEdgeLWidthLocal(:)
integer, pointer :: gridEdgeUWidthLocal(:)
integer, pointer :: gridAlignLocal(:)
integer :: dimCount
integer, pointer :: minIndexLocal(:)
integer, pointer :: maxIndexLocal(:)
integer :: localrc
type(ESMF_DistgridConnection), pointer :: connList(:)
integer :: periodicDimLocal
type(ESMF_CoordSys_Flag) :: coordSysLocal
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
#if DEBUG_POLEKIND
if(present(polekindflag)) then
print *, "GridCreate1PeriDim", polekindflag(1), polekindflag(2)
endif
#endif
! Get IndexSpace
call GetIndexSpaceReg(minIndex, maxIndex, &
dimCount, minIndexLocal, maxIndexLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Build connection list
call Setup1PeriodicConn(dimCount, minIndexLocal, maxIndexLocal, &
polekindflag, periodicDim, poleDim, &
connList, periodicDimLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Compute regular distgrid and error check associated input and set defaults
distgrid=ESMF_GridCreateDistgridReg(dimCount, minIndexLocal, maxIndexLocal, &
regDecomp, decompFlag, indexflag, petMap, connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(name)) then
call ESMF_DistGridSet(distgrid, name="DG-"//trim(name), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Set default widths and alignment and error check
allocate(gridEdgeLWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeLWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridEdgeUWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeUWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridAlignLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridAlignLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridLUA1PeriDim(dimCount, periodicDimLocal,&
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridEdgeLWidthLocal, gridEdgeUWidthLocal, gridAlignLocal, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Convert coordDeps to coordDimCount and coordDimMap
allocate(coordDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimCount", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(coordDimMap(dimCount,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
call CoordInfoFromCoordDep(dimCount, coordDep1, coordDep2, coordDep3,&
coordDimCount, coordDimMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set Default coordSys
if (present(coordSys)) then
coordSysLocal=coordSys
else
coordSysLocal=ESMF_COORDSYS_SPH_DEG
endif
! Create Grid from specification
ESMF_GridCreate1PeriDimR=ESMF_GridCreateFrmDistGrid(&
distgrid, &
coordSys=coordSysLocal, &
coordTypeKind=coordTypeKind, &
coordDimCount=coordDimCount, coordDimMap=coordDimMap, &
gridEdgeLWidth=gridEdgeLWidthLocal, &
gridEdgeUWidth=gridEdgeUWidthLocal, &
gridAlign=gridAlignLocal, &
gridMemLBound=gridMemLBound, &
indexflag=indexflag, &
name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set internal items to be destroyed with grid
call ESMF_GridSetDestroyDistgrid(ESMF_GridCreate1PeriDimR,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout(ESMF_GridCreate1PeriDimR,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(connList)
deallocate(coordDimCount)
deallocate(coordDimMap)
deallocate(gridEdgeLWidthLocal)
deallocate(gridEdgeUWidthLocal)
deallocate(gridAlignLocal)
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreate1PeriDimR
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreate1PeriDimA"
!BOP
! !IROUTINE: ESMF_GridCreate1PeriDim - Create a Grid with one periodic dim and an arbitrary distribution
! !INTERFACE:
! Private name; call using ESMF_GridCreate1PeriDim()
function ESMF_GridCreate1PeriDimA(minIndex, maxIndex, &
arbIndexCount, arbIndexList, keywordEnforcer, &
polekindflag, periodicDim, poleDim, &
coordSys, coordTypeKind, &
coordDep1, coordDep2, coordDep3, &
distDim, name, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreate1PeriDimA
!
! !ARGUMENTS:
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: maxIndex(:)
integer, intent(in) :: arbIndexCount
integer, intent(in) :: arbIndexList(:,:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_PoleKind_Flag), intent(in), optional :: polekindflag(2)
integer, intent(in), optional :: periodicDim
integer, intent(in), optional :: poleDim
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(in), optional :: distDim(:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method creates a single tile, arbitrarily distributed grid
! (see Figure \ref{fig:GridDecomps}) with one periodic dimension.
! To specify the arbitrary distribution, the user passes in an 2D array
! of local indices, where the first dimension is the number of local grid cells
! specified by {\tt localArbIndexCount} and the second dimension is the number of distributed
! dimensions.
!
! {\tt distDim} specifies which grid dimensions are arbitrarily distributed. The
! size of {\tt distDim} has to agree with the size of the second dimension of
! {\tt localArbIndex}.
!
! Currently this call
! only supports creating a 2D or 3D Grid, and thus, for example, {\tt maxIndex} must be of size 2 or 3.
!
!
! The arguments are:
! \begin{description}
! \item[{[minIndex]}]
! Tuple to start the index ranges at. If not present, defaults
! to /1,1,1,.../.
! \item[maxIndex]
! The upper extend of the grid index ranges.
! \item[arbIndexCount]
! The number of grid cells in the local DE. It is okay to have 0
! grid cell in a local DE.
! \item[arbIndexList]
! This 2D array specifies the indices of the PET LOCAL grid cells. The
! dimensions should be arbIndexCount * number of Distributed grid dimensions
! where arbIndexCount is the input argument specified below
! \item[{[polekindflag]}]
! Two item array which specifies the type of connection which occurs at the pole. The value in polekindflag(1)
! specifies the connection that occurs at the minimum end of the pole dimension. The value in polekindflag(2)
! specifies the connection that occurs at the maximum end of the pole dimension. Please see
! Section~\ref{const:polekind} for a full list of options. If not specified,
! the default is {\tt ESMF\_POLEKIND\_MONOPOLE} for both.
! \item[{[periodicDim]}]
! The periodic dimension. If not specified, defaults to 1.
! \item[{[poleDim]}]
! The dimension at who's ends the poles are located. If not specified defaults to 2.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! For a full list of options, please see Section~\ref{const:coordsys}.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[coordDep1]}]
! The size of the array specifies the number of dimensions of the
! first coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. The format should be /ESMF\_DIM\_ARB/ where
! /ESMF\_DIM\_ARB/ is mapped to the collapsed 1D dimension from all
! the arbitrarily distributed dimensions. n is the dimension that
! is not distributed (if exists).
! If not present the default is /ESMF\_DIM\_ARB/ if the first dimension
! is arbitararily distributed, or /n/ if not distributed (i.e. n=1)
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_DIM\_ARB.
! \item[{[coordDep2]}]
! The size of the array specifies the number of dimensions of the
! second coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. The format should be /ESMF\_DIM\_ARB/ where
! /ESMF\_DIM\_ARB/ is mapped to the collapsed 1D dimension from all
! the arbitrarily distributed dimensions. n is the dimension that
! is not distributed (if exists).
! If not present the default is /ESMF\_DIM\_ARB/ if this dimension
! is arbitararily distributed, or /n/ if not distributed (i.e. n=2)
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_DIM\_ARB.
! \item[{[coordDep3]}]
! The size of the array specifies the number of dimensions of the
! third coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. The format should be /ESMF\_DIM\_ARB/ where
! /ESMF\_DIM\_ARB/ is mapped to the collapsed 1D dimension from all
! the arbitrarily distributed dimensions. n is the dimension that
! is not distributed (if exists).
! If not present the default is /ESMF\_DIM\_ARB/ if this dimension
! is arbitararily distributed, or /n/ if not distributed (i.e. n=3)
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_DIM\_ARB.
! \item[{[distDim]}]
! This array specifies which dimensions are arbitrarily distributed.
! The size of the array specifies the total distributed dimensions.
! if not specified, defaults is all dimensions will be arbitrarily
! distributed. The size has to agree with the size of the second
! dimension of {\tt localArbIndex}.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_DistGrid) :: distgrid
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer :: localrc
integer :: dimCount,distDimCount
integer :: i
integer, pointer :: indexArray(:,:)
logical, pointer :: isDistLocal(:)
integer, pointer :: distDimLocal(:)
integer, pointer :: minIndexLocal(:)
integer, pointer :: maxIndexLocal(:)
type(ESMF_DistgridConnection), pointer :: connList(:)
integer :: periodicDimLocal
type(ESMF_CoordSys_Flag) :: coordSysLocal
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Get description of index space and what's undistributed
call GetIndexSpaceArb(minIndex, maxIndex, &
arbIndexCount, arbIndexList, distDim, &
dimCount, distDimCount, isDistLocal, distDimLocal, &
minIndexLocal, maxIndexLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Build connection list
call Setup1PeriodicConn(dimCount, minIndexLocal, maxIndexLocal, &
polekindflag, periodicDim, poleDim, &
connList, periodicDimLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Create arbitrary distgrid
distgrid= ESMF_GridCreateDistgridArb(dimCount, distDimCount, isDistLocal, distDimLocal, &
minIndexLocal, maxIndexLocal, arbIndexCount, arbIndexList, connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(name)) then
call ESMF_DistGridSet(distgrid, name="DG-"//trim(name), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Convert coordDeps to coordDimCount and coordDimMap
allocate(coordDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimCount", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(coordDimMap(dimCount,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
call CoordInfoFromCoordDepArb(dimCount, isDistLocal, coordDep1, coordDep2, coordDep3,&
coordDimCount, coordDimMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Put minIndex, maxIndex into indexArray for create from distgrid
allocate(indexArray(2,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating indexArray", &
ESMF_CONTEXT, rcToReturn=rc)) return
indexArray(1,:)=minIndexLocal(:)
indexArray(2,:)=maxIndexLocal(:)
! Set Default coordSys
if (present(coordSys)) then
coordSysLocal=coordSys
else
coordSysLocal=ESMF_COORDSYS_SPH_DEG
endif
! Create Grid from specification -----------------------------------------------
ESMF_GridCreate1PeriDimA=ESMF_GridCreateFrmDistGridArb( &
distgrid, indexArray, &
distDim=distDimLocal, &
coordSys=coordSysLocal, &
coordTypeKind=coordTypeKind, &
coordDimCount=coordDimCount, coordDimMap=coordDimMap, &
name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set internal items to be destroyed with grid
call ESMF_GridSetDestroyDistgrid(ESMF_GridCreate1PeriDimA,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout(ESMF_GridCreate1PeriDimA,destroy=.false., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(connList)
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
deallocate(isDistLocal)
deallocate(indexArray)
deallocate(distDimLocal)
deallocate(coordDimCount)
deallocate(coordDimMap)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreate1PeriDimA
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreate2PeriDimI"
!BOP
! !IROUTINE: ESMF_GridCreate2PeriDim - Create a Grid with two periodic dims and an irregular distribution
! !INTERFACE:
! Private name; call using ESMF_GridCreate2PeriDim()
function ESMF_GridCreate2PeriDimI(minIndex, &
countsPerDEDim1,countsPerDeDim2, keywordEnforcer, &
countsPerDEDim3, &
coordSys, coordTypeKind, &
coordDep1, coordDep2, coordDep3, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridMemLBound, indexflag, petMap, name, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreate2PeriDimI
!
! !ARGUMENTS:
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: countsPerDEDim1(:)
integer, intent(in) :: countsPerDEDim2(:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(in), optional :: countsPerDEDim3(:)
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(in), optional :: gridEdgeLWidth(:)
integer, intent(in), optional :: gridEdgeUWidth(:)
integer, intent(in), optional :: gridAlign(:)
integer, intent(in), optional :: gridMemLBound(:)
type(ESMF_Index_Flag), intent(in), optional :: indexflag
integer, intent(in), optional :: petMap(:,:,:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method creates a single tile, irregularly distributed grid
! (see Figure \ref{fig:GridDecomps}) with two periodic dimensions.
! To specify the irregular distribution, the user passes in an array
! for each grid dimension, where the length of the array is the number
! of DEs in the dimension. Currently this call only
! supports creating 2D or 3D Grids. A 2D Grid can be specified using the
! countsPerDEDim1 and countsPerDEDim2 arguments. A 3D Grid can
! be specified by also using the optional countsPerDEDim3 argument.
! The index of each array element in these arguments corresponds to
! a DE number. The array value at the index is the number of grid
! cells on the DE in that dimension.
!
! Section \ref{example:2DIrregUniGrid} shows an example
! of using this method to create a 2D Grid with uniformly spaced
! coordinates. This creation method can also be used as the basis for
! grids with rectilinear coordinates or curvilinear coordinates.
!
! The arguments are:
! \begin{description}
! \item[{[minIndex]}]
! Tuple to start the index ranges at. If not present, defaults
! to /1,1,1,.../.
! \item[countsPerDEDim1]
! This arrays specifies the number of cells per DE for index dimension 1
! for the exclusive region (the center stagger location).
! \item[countsPerDEDim2]
! This array specifies the number of cells per DE for index dimension 2
! for the exclusive region (center stagger location).
! \item[{[countsPerDEDim3]}]
! This array specifies the number of cells per DE for index dimension 3
! for the exclusive region (center stagger location).
! If not specified then grid is 2D.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! For a full list of options, please see Section~\ref{const:coordsys}.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[coordDep1]}]
! This array specifies the dependence of the first
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the first
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep2]}]
! This array specifies the dependence of the second
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the second
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep3]}]
! This array specifies the dependence of the third
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the third
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[gridEdgeLWidth]}]
! The padding around the lower edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 0, 0, ..., 0 (all zeros).
! \item[{[gridEdgeUWidth]}]
! The padding around the upper edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 1, 1, ..., 1 (all ones).
! \item[{[gridAlign]}]
! Specification of how the stagger locations should align with the cell
! index space (can be overridden by the individual staggerAligns). If
! the gridEdgeWidths are not specified than this argument
! implies the gridEdgeWidths. If the gridEdgeWidths are specified and this argument isn't
! then this argument is implied by the gridEdgeWidths.
! If this and the gridEdgeWidths are not specified, then defaults to
! -1, -1, ..., -1 (all negative ones).
! \item[{[gridMemLBound]}]
! Specifies the lower index range of the memory of every DE in this Grid.
! Only used when indexflag is {\tt ESMF\_INDEX\_USER}. May be overridden
! by staggerMemLBound.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[petMap]}]
! \begin{sloppypar}
! Sets the mapping of pets to the created DEs. This 3D
! should be of size size(countsPerDEDim1) x size(countsPerDEDim2) x
! size(countsPerDEDim3). If countsPerDEDim3 isn't present, then
! the last dimension is of size 1.
! \end{sloppypar}
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_DistGrid) :: distgrid
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer :: localrc
integer :: dimCount
integer, pointer :: gridEdgeLWidthLocal(:)
integer, pointer :: gridEdgeUWidthLocal(:)
integer, pointer :: gridAlignLocal(:)
integer, pointer :: minIndexLocal(:)
integer, pointer :: maxIndexLocal(:)
type(ESMF_DistgridConnection), pointer :: connList(:)
type(ESMF_CoordSys_Flag) :: coordSysLocal
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Get the dimension and extent of the index space
call GetIndexSpaceIrreg(minIndex, &
countsPerDEDim1,countsPerDeDim2, &
countsPerDEDim3, dimCount, minIndexLocal, maxIndexLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Build connection list
call Setup2PeriodicConn(dimCount, minIndexLocal, maxIndexLocal, &
connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Create Irregular distgrid and error check associated input and set defaults
distgrid=ESMF_GridCreateDistgridIrreg(dimCount, minIndexLocal, maxIndexLocal, &
countsPerDEDim1,countsPerDeDim2, &
countsPerDEDim3, indexflag, petMap, connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(name)) then
call ESMF_DistGridSet(distgrid, name="DG-"//trim(name), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Set default widths and alignment and error check
allocate(gridEdgeLWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeLWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridEdgeUWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeUWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridAlignLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridAlignLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridLUA2PeriDim(dimCount, 1, 2,&
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridEdgeLWidthLocal, gridEdgeUWidthLocal, gridAlignLocal, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Convert coordDeps to coordDimCount and coordDimMap
allocate(coordDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimCount", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(coordDimMap(dimCount,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
call CoordInfoFromCoordDep(dimCount, coordDep1, coordDep2, coordDep3,&
coordDimCount, coordDimMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set Default coordSys
if (present(coordSys)) then
coordSysLocal=coordSys
else
coordSysLocal=ESMF_COORDSYS_SPH_DEG
endif
! Create Grid from specification
ESMF_GridCreate2PeriDimI=ESMF_GridCreateFrmDistGrid( &
distgrid, &
coordSys=coordSysLocal, &
coordTypeKind=coordTypeKind, &
coordDimCount=coordDimCount, coordDimMap=coordDimMap, &
gridEdgeLWidth=gridEdgeLWidthLocal, &
gridEdgeUWidth=gridEdgeUWidthLocal, &
gridAlign=gridAlignLocal, &
gridMemLBound=gridMemLBound, &
indexflag=indexflag, &
name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set internal items to be destroyed with grid
Call ESMF_GridSetDestroyDistgrid( ESMF_GridCreate2PeriDimI,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout( ESMF_GridCreate2PeriDimI,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(connList)
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
deallocate(coordDimCount)
deallocate(coordDimMap)
deallocate(gridEdgeLWidthLocal)
deallocate(gridEdgeUWidthLocal)
deallocate(gridAlignLocal)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreate2PeriDimI
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreate2PeriDimR"
!BOP
! !IROUTINE: ESMF_GridCreate2PeriDim - Create a Grid with two periodic dims and a regular distribution
! !INTERFACE:
! Private name; call using ESMF_GridCreate2PeriDim()
function ESMF_GridCreate2PeriDimR(regDecomp, decompFlag, &
minIndex, maxIndex, keywordEnforcer, &
coordSys, coordTypeKind, &
coordDep1, coordDep2, coordDep3, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridMemLBound, indexflag, petMap, name, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreate2PeriDimR
!
! !ARGUMENTS:
integer, intent(in), optional :: regDecomp(:)
type(ESMF_Decomp_Flag), intent(in), optional :: decompflag(:)
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: maxIndex(:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(in), optional :: gridEdgeLWidth(:)
integer, intent(in), optional :: gridEdgeUWidth(:)
integer, intent(in), optional :: gridAlign(:)
integer, intent(in), optional :: gridMemLBound(:)
type(ESMF_Index_Flag), intent(in), optional :: indexflag
integer, intent(in), optional :: petMap(:,:,:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method creates a single tile, regularly distributed grid
! (see Figure \ref{fig:GridDecomps}) with two periodic dimensions.
! To specify the distribution, the user passes in an array
! ({\tt regDecomp}) specifying the number of DEs to divide each
! dimension into. The array {\tt decompFlag} indicates how the division into DEs is to
! occur. The default is to divide the range as evenly as possible. Currently this call
! only supports creating a 2D or 3D Grid, and thus, for example, {\tt maxIndex} must be of size 2 or 3.
!
! The arguments are:
! \begin{description}
! \item[{[regDecomp]}]
! List that has the same number of elements as {\tt maxIndex}.
! Each entry is the number of decounts for that dimension.
! If not specified, the default decomposition will be petCountx1x1..x1.
! \item[{[decompflag]}]
! List of decomposition flags indicating how each dimension of the
! tile is to be divided between the DEs. The default setting
! is {\tt ESMF\_DECOMP\_BALANCED} in all dimensions. Please see
! Section~\ref{const:decompflag} for a full description of the
! possible options. Note that currently the option
! {\tt ESMF\_DECOMP\_CYCLIC} isn't supported in Grid creation.
! \item[{[minIndex]}]
! The bottom extent of the grid array. If not given then the value defaults
! to /1,1,1,.../.
! \item[maxIndex]
! The upper extent of the grid array.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! For a full list of options, please see Section~\ref{const:coordsys}.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[coordDep1]}]
! This array specifies the dependence of the first
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the first
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep2]}]
! This array specifies the dependence of the second
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the second
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep3]}]
! This array specifies the dependence of the third
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the third
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[gridEdgeLWidth]}]
! The padding around the lower edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 0, 0, ..., 0 (all zeros).
! \item[{[gridEdgeUWidth]}]
! The padding around the upper edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 1, 1, ..., 1 (all ones).
! \item[{[gridAlign]}]
! Specification of how the stagger locations should align with the cell
! index space (can be overridden by the individual staggerAligns). If
! the gridEdgeWidths are not specified than this argument
! implies the gridEdgeWidths. If the gridEdgeWidths are specified and this argument isn't
! then this argument is implied by the gridEdgeWidths.
! If this and the gridEdgeWidths are not specified, then defaults to
! -1, -1, ..., -1 (all negative ones).
! \item[{[gridMemLBound]}]
! Specifies the lower index range of the memory of every DE in this Grid.
! Only used when indexflag is {\tt ESMF\_INDEX\_USER}. May be overridden
! by staggerMemLBound.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[petMap]}]
! Sets the mapping of pets to the created DEs. This 3D
! should be of size regDecomp(1) x regDecomp(2) x regDecomp(3)
! If the Grid is 2D, then the last dimension is of size 1.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_DistGrid) :: distgrid
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer, pointer :: gridEdgeLWidthLocal(:)
integer, pointer :: gridEdgeUWidthLocal(:)
integer, pointer :: gridAlignLocal(:)
integer :: dimCount
integer, pointer :: minIndexLocal(:)
integer, pointer :: maxIndexLocal(:)
integer :: localrc
type(ESMF_DistgridConnection), pointer :: connList(:)
type(ESMF_CoordSys_Flag) :: coordSysLocal
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Get IndexSpace
call GetIndexSpaceReg(minIndex, maxIndex, &
dimCount, minIndexLocal, maxIndexLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Build connection list
call Setup2PeriodicConn(dimCount, minIndexLocal, maxIndexLocal, &
connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Compute regular distgrid and error check associated input and set defaults
distgrid=ESMF_GridCreateDistgridReg(dimCount, minIndexLocal, maxIndexLocal, &
regDecomp, decompFlag, indexflag, petMap, connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(name)) then
call ESMF_DistGridSet(distgrid, name="DG-"//trim(name), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Set default widths and alignment and error check
allocate(gridEdgeLWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeLWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridEdgeUWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeUWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridAlignLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridAlignLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridLUA2PeriDim(dimCount, 1, 2, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridEdgeLWidthLocal, gridEdgeUWidthLocal, gridAlignLocal, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Convert coordDeps to coordDimCount and coordDimMap
allocate(coordDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimCount", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(coordDimMap(dimCount,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
call CoordInfoFromCoordDep(dimCount, coordDep1, coordDep2, coordDep3,&
coordDimCount, coordDimMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set Default coordSys
if (present(coordSys)) then
coordSysLocal=coordSys
else
coordSysLocal=ESMF_COORDSYS_SPH_DEG
endif
! Create Grid from specification
ESMF_GridCreate2PeriDimR=ESMF_GridCreateFrmDistGrid(&
distgrid, &
coordSys=coordSysLocal, &
coordTypeKind=coordTypeKind, &
coordDimCount=coordDimCount, coordDimMap=coordDimMap, &
gridEdgeLWidth=gridEdgeLWidthLocal, &
gridEdgeUWidth=gridEdgeUWidthLocal, &
gridAlign=gridAlignLocal, &
gridMemLBound=gridMemLBound, &
indexflag=indexflag, &
name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set internal items to be destroyed with grid
call ESMF_GridSetDestroyDistgrid(ESMF_GridCreate2PeriDimR,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout(ESMF_GridCreate2PeriDimR,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(connList)
deallocate(coordDimCount)
deallocate(coordDimMap)
deallocate(gridEdgeLWidthLocal)
deallocate(gridEdgeUWidthLocal)
deallocate(gridAlignLocal)
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreate2PeriDimR
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreate2PeriDimA"
!BOP
! !IROUTINE: ESMF_GridCreate2PeriDim - Create a Grid with two periodic dims and an arbitrary distribution
! !INTERFACE:
! Private name; call using ESMF_GridCreate2PeriDim()
function ESMF_GridCreate2PeriDimA(minIndex, maxIndex, &
arbIndexCount, arbIndexList, keywordEnforcer, &
coordSys, coordTypeKind, &
coordDep1, coordDep2, coordDep3, &
distDim, name, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreate2PeriDimA
!
! !ARGUMENTS:
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: maxIndex(:)
integer, intent(in) :: arbIndexCount
integer, intent(in) :: arbIndexList(:,:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(in), optional :: distDim(:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method creates a single tile, arbitrarily distributed grid
! (see Figure \ref{fig:GridDecomps}) with two periodic dimensions.
! To specify the arbitrary distribution, the user passes in an 2D array
! of local indices, where the first dimension is the number of local grid cells
! specified by {\tt localArbIndexCount} and the second dimension is the number of distributed
! dimensions.
!
! {\tt distDim} specifies which grid dimensions are arbitrarily distributed. The
! size of {\tt distDim} has to agree with the size of the second dimension of
! {\tt localArbIndex}.
!
! Currently this call
! only supports creating a 2D or 3D Grid, and thus, for example, {\tt maxIndex} must be of size 2 or 3.
!
!
! The arguments are:
! \begin{description}
! \item[{[minIndex]}]
! Tuple to start the index ranges at. If not present, defaults
! to /1,1,1,.../.
! \item[maxIndex]
! The upper extend of the grid index ranges.
! \item[arbIndexCount]
! The number of grid cells in the local DE. It is okay to have 0
! grid cell in a local DE.
! \item[arbIndexList]
! This 2D array specifies the indices of the PET LOCAL grid cells. The
! dimensions should be arbIndexCount * number of Distributed grid dimensions
! where arbIndexCount is the input argument specified below
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! For a full list of options, please see Section~\ref{const:coordsys}.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[coordDep1]}]
! The size of the array specifies the number of dimensions of the
! first coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. The format should be /ESMF\_DIM\_ARB/ where
! /ESMF\_DIM\_ARB/ is mapped to the collapsed 1D dimension from all
! the arbitrarily distributed dimensions. n is the dimension that
! is not distributed (if exists).
! If not present the default is /ESMF\_DIM\_ARB/ if the first dimension
! is arbitararily distributed, or /n/ if not distributed (i.e. n=1)
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_DIM\_ARB.
! \item[{[coordDep2]}]
! The size of the array specifies the number of dimensions of the
! second coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. The format should be /ESMF\_DIM\_ARB/ where
! /ESMF\_DIM\_ARB/ is mapped to the collapsed 1D dimension from all
! the arbitrarily distributed dimensions. n is the dimension that
! is not distributed (if exists).
! If not present the default is /ESMF\_DIM\_ARB/ if this dimension
! is arbitararily distributed, or /n/ if not distributed (i.e. n=2)
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_DIM\_ARB.
! \item[{[coordDep3]}]
! The size of the array specifies the number of dimensions of the
! third coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. The format should be /ESMF\_DIM\_ARB/ where
! /ESMF\_DIM\_ARB/ is mapped to the collapsed 1D dimension from all
! the arbitrarily distributed dimensions. n is the dimension that
! is not distributed (if exists).
! If not present the default is /ESMF\_DIM\_ARB/ if this dimension
! is arbitararily distributed, or /n/ if not distributed (i.e. n=3)
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_DIM\_ARB.
! \item[{[distDim]}]
! This array specifies which dimensions are arbitrarily distributed.
! The size of the array specifies the total distributed dimensions.
! if not specified, defaults is all dimensions will be arbitrarily
! distributed. The size has to agree with the size of the second
! dimension of {\tt localArbIndex}.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_DistGrid) :: distgrid
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer :: localrc
integer :: dimCount,distDimCount
integer :: i
integer, pointer :: indexArray(:,:)
logical, pointer :: isDistLocal(:)
integer, pointer :: distDimLocal(:)
integer, pointer :: minIndexLocal(:)
integer, pointer :: maxIndexLocal(:)
type(ESMF_DistgridConnection), pointer :: connList(:)
type(ESMF_CoordSys_Flag) :: coordSysLocal
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Get description of index space and what's undistributed
call GetIndexSpaceArb(minIndex, maxIndex, &
arbIndexCount, arbIndexList, distDim, &
dimCount, distDimCount, isDistLocal, distDimLocal, &
minIndexLocal, maxIndexLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Build connection list
call Setup2PeriodicConn(dimCount, minIndexLocal, maxIndexLocal, &
connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Create arbitrary distgrid
distgrid= ESMF_GridCreateDistgridArb(dimCount, distDimCount, isDistLocal, distDimLocal, &
minIndexLocal, maxIndexLocal, arbIndexCount, arbIndexList, connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(name)) then
call ESMF_DistGridSet(distgrid, name="DG-"//trim(name), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Convert coordDeps to coordDimCount and coordDimMap
allocate(coordDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimCount", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(coordDimMap(dimCount,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
call CoordInfoFromCoordDepArb(dimCount, isDistLocal, coordDep1, coordDep2, coordDep3,&
coordDimCount, coordDimMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Put minIndex, maxIndex into indexArray for create from distgrid
allocate(indexArray(2,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating indexArray", &
ESMF_CONTEXT, rcToReturn=rc)) return
indexArray(1,:)=minIndexLocal(:)
indexArray(2,:)=maxIndexLocal(:)
! Set Default coordSys
if (present(coordSys)) then
coordSysLocal=coordSys
else
coordSysLocal=ESMF_COORDSYS_SPH_DEG
endif
! Create Grid from specification -----------------------------------------------
ESMF_GridCreate2PeriDimA=ESMF_GridCreateFrmDistGridArb( &
distgrid, indexArray, &
distDim=distDimLocal, &
coordSys=coordSysLocal, &
coordTypeKind=coordTypeKind, &
coordDimCount=coordDimCount, coordDimMap=coordDimMap, &
name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set internal items to be destroyed with grid
call ESMF_GridSetDestroyDistgrid(ESMF_GridCreate2PeriDimA,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout(ESMF_GridCreate2PeriDimA,destroy=.false., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(connList)
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
deallocate(isDistLocal)
deallocate(indexArray)
deallocate(distDimLocal)
deallocate(coordDimCount)
deallocate(coordDimMap)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreate2PeriDimA
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateNoPeriDimI"
!BOP
! !IROUTINE: ESMF_GridCreateNoPeriDim - Create a Grid with no periodic dim and an irregular distribution
! !INTERFACE:
! Private name; call using ESMF_GridCreateNoPeriDim()
function ESMF_GridCreateNoPeriDimI(minIndex, &
countsPerDEDim1,countsPerDeDim2, keywordEnforcer, &
countsPerDEDim3, &
coordSys, coordTypeKind, &
coordDep1, coordDep2, coordDep3, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridMemLBound, indexflag, petMap, name, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateNoPeriDimI
!
! !ARGUMENTS:
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: countsPerDEDim1(:)
integer, intent(in) :: countsPerDEDim2(:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(in), optional :: countsPerDEDim3(:)
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(in), optional :: gridEdgeLWidth(:)
integer, intent(in), optional :: gridEdgeUWidth(:)
integer, intent(in), optional :: gridAlign(:)
integer, intent(in), optional :: gridMemLBound(:)
type(ESMF_Index_Flag), intent(in), optional :: indexflag
integer, intent(in), optional :: petMap(:,:,:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method creates a single tile, irregularly distributed grid
! (see Figure \ref{fig:GridDecomps}) without a periodic dimension.
! To specify the irregular distribution, the user passes in an array
! for each grid dimension, where the length of the array is the number
! of DEs in the dimension. Currently this call only
! supports creating 2D or 3D Grids. A 2D Grid can be specified using the
! countsPerDEDim1 and countsPerDEDim2 arguments. A 3D Grid can
! be specified by also using the optional countsPerDEDim3 argument.
! The index of each array element in these arguments corresponds to
! a DE number. The array value at the index is the number of grid
! cells on the DE in that dimension.
!
! Section \ref{example:2DIrregUniGrid} shows an example
! of using this method to create a 2D Grid with uniformly spaced
! coordinates. This creation method can also be used as the basis for
! grids with rectilinear coordinates or curvilinear coordinates.
!
! The arguments are:
! \begin{description}
! \item[{[minIndex]}]
! Tuple to start the index ranges at. If not present, defaults
! to /1,1,1,.../.
! \item[countsPerDEDim1]
! This arrays specifies the number of cells per DE for index dimension 1
! for the exclusive region (the center stagger location).
! \item[countsPerDEDim2]
! This array specifies the number of cells per DE for index dimension 2
! for the exclusive region (center stagger location).
! \item[{[countsPerDEDim3]}]
! This array specifies the number of cells per DE for index dimension 3
! for the exclusive region (center stagger location).
! If not specified then grid is 2D.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! For a full list of options, please see Section~\ref{const:coordsys}.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[coordDep1]}]
! This array specifies the dependence of the first
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the first
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep2]}]
! This array specifies the dependence of the second
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the second
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep3]}]
! This array specifies the dependence of the third
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the third
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[gridEdgeLWidth]}]
! The padding around the lower edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 0, 0, ..., 0 (all zeros).
! \item[{[gridEdgeUWidth]}]
! The padding around the upper edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 1, 1, ..., 1 (all ones).
! \item[{[gridAlign]}]
! Specification of how the stagger locations should align with the cell
! index space (can be overridden by the individual staggerAligns). If
! the gridEdgeWidths are not specified than this argument
! implies the gridEdgeWidths. If the gridEdgeWidths are specified and this argument isn't
! then this argument is implied by the gridEdgeWidths.
! If this and the gridEdgeWidths are not specified, then defaults to
! -1, -1, ..., -1 (all negative ones).
! \item[{[gridMemLBound]}]
! Specifies the lower index range of the memory of every DE in this Grid.
! Only used when indexflag is {\tt ESMF\_INDEX\_USER}. May be overridden
! by staggerMemLBound.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[petMap]}]
! \begin{sloppypar}
! Sets the mapping of pets to the created DEs. This 3D
! should be of size size(countsPerDEDim1) x size(countsPerDEDim2) x
! size(countsPerDEDim3). If countsPerDEDim3 isn't present, then
! the last dimension is of size 1.
! \end{sloppypar}
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_DistGrid) :: distgrid
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer :: localrc
integer :: dimCount
integer, pointer :: gridEdgeLWidthLocal(:)
integer, pointer :: gridEdgeUWidthLocal(:)
integer, pointer :: gridAlignLocal(:)
integer, pointer :: minIndexLocal(:)
integer, pointer :: maxIndexLocal(:)
type(ESMF_CoordSys_Flag) :: coordSysLocal
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Get the dimension and extent of the index space
call GetIndexSpaceIrreg(minIndex, &
countsPerDEDim1,countsPerDeDim2, &
countsPerDEDim3, dimCount, minIndexLocal, maxIndexLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Create Irregular distgrid and error check associated input and set defaults
distgrid=ESMF_GridCreateDistgridIrreg(dimCount, minIndexLocal, maxIndexLocal, &
countsPerDEDim1,countsPerDeDim2, &
countsPerDEDim3, indexflag, petMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(name)) then
call ESMF_DistGridSet(distgrid, name="DG-"//trim(name), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Set default widths and alignment and error check
allocate(gridEdgeLWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeLWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridEdgeUWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeUWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridAlignLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridAlignLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridLUADefault(dimCount, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridEdgeLWidthLocal, gridEdgeUWidthLocal, gridAlignLocal, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Convert coordDeps to coordDimCount and coordDimMap
allocate(coordDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimCount", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(coordDimMap(dimCount,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
call CoordInfoFromCoordDep(dimCount, coordDep1, coordDep2, coordDep3,&
coordDimCount, coordDimMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set Default coordSys
if (present(coordSys)) then
coordSysLocal=coordSys
else
coordSysLocal=ESMF_COORDSYS_SPH_DEG
endif
! Create Grid from specification
ESMF_GridCreateNoPeriDimI=ESMF_GridCreateFrmDistGrid( &
distgrid, &
coordSys=coordSysLocal, &
coordTypeKind=coordTypeKind, &
coordDimCount=coordDimCount, coordDimMap=coordDimMap, &
gridEdgeLWidth=gridEdgeLWidthLocal, &
gridEdgeUWidth=gridEdgeUWidthLocal, &
gridAlign=gridAlignLocal, &
gridMemLBound=gridMemLBound, &
indexflag=indexflag, &
name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set internal items to be destroyed with grid
Call ESMF_GridSetDestroyDistgrid( ESMF_GridCreateNoPeriDimI,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout( ESMF_GridCreateNoPeriDimI,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
deallocate(coordDimCount)
deallocate(coordDimMap)
deallocate(gridEdgeLWidthLocal)
deallocate(gridEdgeUWidthLocal)
deallocate(gridAlignLocal)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreateNoPeriDimI
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateNoPeriDimR"
!BOP
! !IROUTINE: ESMF_GridCreateNoPeriDim - Create a Grid with no periodic dim and a regular distribution
! !INTERFACE:
! Private name; call using ESMF_GridCreateNoPeriDim()
function ESMF_GridCreateNoPeriDimR(regDecomp, decompFlag, &
minIndex, maxIndex, keywordEnforcer, &
coordSys, coordTypeKind, &
coordDep1, coordDep2, coordDep3, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridMemLBound, indexflag, petMap, name, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateNoPeriDimR
!
! !ARGUMENTS:
integer, intent(in), optional :: regDecomp(:)
type(ESMF_Decomp_Flag), intent(in), optional :: decompflag(:)
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: maxIndex(:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(in), optional :: gridEdgeLWidth(:)
integer, intent(in), optional :: gridEdgeUWidth(:)
integer, intent(in), optional :: gridAlign(:)
integer, intent(in), optional :: gridMemLBound(:)
type(ESMF_Index_Flag), intent(in), optional :: indexflag
integer, intent(in), optional :: petMap(:,:,:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method creates a single tile, regularly distributed grid
! (see Figure \ref{fig:GridDecomps}) with no periodic dimension.
! To specify the distribution, the user passes in an array
! ({\tt regDecomp}) specifying the number of DEs to divide each
! dimension into. The array {\tt decompFlag} indicates how the division into DEs is to
! occur. The default is to divide the range as evenly as possible. Currently this call
! only supports creating a 2D or 3D Grid, and thus, for example, {\tt maxIndex} must be of size 2 or 3.
!
! The arguments are:
! \begin{description}
! \item[{[regDecomp]}]
! List that has the same number of elements as {\tt maxIndex}.
! Each entry is the number of decounts for that dimension.
! If not specified, the default decomposition will be petCountx1x1..x1.
! \item[{[decompflag]}]
! List of decomposition flags indicating how each dimension of the
! tile is to be divided between the DEs. The default setting
! is {\tt ESMF\_DECOMP\_BALANCED} in all dimensions. Please see
! Section~\ref{const:decompflag} for a full description of the
! possible options. Note that currently the option
! {\tt ESMF\_DECOMP\_CYCLIC} isn't supported in Grid creation.
! \item[{[minIndex]}]
! The bottom extent of the grid array. If not given then the value defaults
! to /1,1,1,.../.
! \item[maxIndex]
! The upper extent of the grid array.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! For a full list of options, please see Section~\ref{const:coordsys}.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[coordDep1]}]
! This array specifies the dependence of the first
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the first
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep2]}]
! This array specifies the dependence of the second
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the second
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep3]}]
! This array specifies the dependence of the third
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the third
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[gridEdgeLWidth]}]
! The padding around the lower edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 0, 0, ..., 0 (all zeros).
! \item[{[gridEdgeUWidth]}]
! The padding around the upper edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 1, 1, ..., 1 (all ones).
! \item[{[gridAlign]}]
! Specification of how the stagger locations should align with the cell
! index space (can be overridden by the individual staggerAligns). If
! the gridEdgeWidths are not specified than this argument
! implies the gridEdgeWidths. If the gridEdgeWidths are specified and this argument isn't
! then this argument is implied by the gridEdgeWidths.
! If this and the gridEdgeWidths are not specified, then defaults to
! -1, -1, ..., -1 (all negative ones).
! \item[{[gridMemLBound]}]
! Specifies the lower index range of the memory of every DE in this Grid.
! Only used when indexflag is {\tt ESMF\_INDEX\_USER}. May be overridden
! by staggerMemLBound.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[petMap]}]
! Sets the mapping of pets to the created DEs. This 3D
! should be of size regDecomp(1) x regDecomp(2) x regDecomp(3)
! If the Grid is 2D, then the last dimension is of size 1.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_DistGrid) :: distgrid
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer, pointer :: gridEdgeLWidthLocal(:)
integer, pointer :: gridEdgeUWidthLocal(:)
integer, pointer :: gridAlignLocal(:)
integer :: dimCount
integer, pointer :: minIndexLocal(:)
integer, pointer :: maxIndexLocal(:)
integer :: localrc
type(ESMF_CoordSys_Flag) :: coordSysLocal
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Get IndexSpace
call GetIndexSpaceReg(minIndex, maxIndex, &
dimCount, minIndexLocal, maxIndexLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Compute regular distgrid and error check associated input and set defaults
distgrid=ESMF_GridCreateDistgridReg(dimCount, minIndexLocal, maxIndexLocal, &
regDecomp, decompFlag, indexflag, petMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(name)) then
call ESMF_DistGridSet(distgrid, name="DG-"//trim(name), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Set default widths and alignment and error check
allocate(gridEdgeLWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeLWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridEdgeUWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeUWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridAlignLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridAlignLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridLUADefault(dimCount, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridEdgeLWidthLocal, gridEdgeUWidthLocal, gridAlignLocal, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Convert coordDeps to coordDimCount and coordDimMap
allocate(coordDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimCount", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(coordDimMap(dimCount,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
call CoordInfoFromCoordDep(dimCount, coordDep1, coordDep2, coordDep3,&
coordDimCount, coordDimMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set Default coordSys
if (present(coordSys)) then
coordSysLocal=coordSys
else
coordSysLocal=ESMF_COORDSYS_SPH_DEG
endif
! Create Grid from specification
ESMF_GridCreateNoPeriDimR=ESMF_GridCreateFrmDistGrid(&
distgrid, &
coordSys=coordSysLocal, &
coordTypeKind=coordTypeKind, &
coordDimCount=coordDimCount, coordDimMap=coordDimMap, &
gridEdgeLWidth=gridEdgeLWidthLocal, &
gridEdgeUWidth=gridEdgeUWidthLocal, &
gridAlign=gridAlignLocal, &
gridMemLBound=gridMemLBound, &
indexflag=indexflag, &
name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set internal items to be destroyed with grid
call ESMF_GridSetDestroyDistgrid(ESMF_GridCreateNoPeriDimR,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout(ESMF_GridCreateNoPeriDimR,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(coordDimCount)
deallocate(coordDimMap)
deallocate(gridEdgeLWidthLocal)
deallocate(gridEdgeUWidthLocal)
deallocate(gridAlignLocal)
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreateNoPeriDimR
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateNoPeriDimA"
!BOP
! !IROUTINE: ESMF_GridCreateNoPeriDim - Create a Grid with no periodic dim and an arbitrary distribution
! !INTERFACE:
! Private name; call using ESMF_GridCreateNoPeriodic()
function ESMF_GridCreateNoPeriDimA(minIndex, maxIndex, &
arbIndexCount, arbIndexList, keywordEnforcer, &
coordSys, coordTypeKind, &
coordDep1, coordDep2, coordDep3, &
distDim, name, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateNoPeriDimA
!
! !ARGUMENTS:
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: maxIndex(:)
integer, intent(in) :: arbIndexCount
integer, intent(in) :: arbIndexList(:,:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(in), optional :: distDim(:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method creates a single tile, arbitrarily distributed grid
! (see Figure \ref{fig:GridDecomps}) with no periodic dimension.
! To specify the arbitrary distribution, the user passes in an 2D array
! of local indices, where the first dimension is the number of local grid cells
! specified by {\tt localArbIndexCount} and the second dimension is the number of distributed
! dimensions.
!
! {\tt distDim} specifies which grid dimensions are arbitrarily distributed. The
! size of {\tt distDim} has to agree with the size of the second dimension of
! {\tt localArbIndex}.
!
! Currently this call
! only supports creating a 2D or 3D Grid, and thus, for example, {\tt maxIndex} must be of size 2 or 3.
!
!
! The arguments are:
! \begin{description}
! \item[{[minIndex]}]
! Tuple to start the index ranges at. If not present, defaults
! to /1,1,1,.../.
! \item[maxIndex]
! The upper extend of the grid index ranges.
! \item[arbIndexCount]
! The number of grid cells in the local DE. It is okay to have 0
! grid cell in a local DE.
! \item[arbIndexList]
! This 2D array specifies the indices of the PET LOCAL grid cells. The
! dimensions should be arbIndexCount * number of Distributed grid dimensions
! where arbIndexCount is the input argument specified below
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! For a full list of options, please see Section~\ref{const:coordsys}.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[coordDep1]}]
! The size of the array specifies the number of dimensions of the
! first coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. The format should be /ESMF\_DIM\_ARB/ where
! /ESMF\_DIM\_ARB/ is mapped to the collapsed 1D dimension from all
! the arbitrarily distributed dimensions. n is the dimension that
! is not distributed (if exists).
! If not present the default is /ESMF\_DIM\_ARB/ if the first dimension
! is arbitararily distributed, or /n/ if not distributed (i.e. n=1)
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_DIM\_ARB.
! \item[{[coordDep2]}]
! The size of the array specifies the number of dimensions of the
! second coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. The format should be /ESMF\_DIM\_ARB/ where
! /ESMF\_DIM\_ARB/ is mapped to the collapsed 1D dimension from all
! the arbitrarily distributed dimensions. n is the dimension that
! is not distributed (if exists).
! If not present the default is /ESMF\_DIM\_ARB/ if this dimension
! is arbitararily distributed, or /n/ if not distributed (i.e. n=2)
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_DIM\_ARB.
! \item[{[coordDep3]}]
! The size of the array specifies the number of dimensions of the
! third coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. The format should be /ESMF\_DIM\_ARB/ where
! /ESMF\_DIM\_ARB/ is mapped to the collapsed 1D dimension from all
! the arbitrarily distributed dimensions. n is the dimension that
! is not distributed (if exists).
! If not present the default is /ESMF\_DIM\_ARB/ if this dimension
! is arbitararily distributed, or /n/ if not distributed (i.e. n=3)
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_DIM\_ARB.
! \item[{[distDim]}]
! This array specifies which dimensions are arbitrarily distributed.
! The size of the array specifies the total distributed dimensions.
! if not specified, defaults is all dimensions will be arbitrarily
! distributed. The size has to agree with the size of the second
! dimension of {\tt localArbIndex}.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_DistGrid) :: distgrid
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer :: localrc
integer :: dimCount,distDimCount
integer :: i
integer, pointer :: indexArray(:,:)
logical, pointer :: isDistLocal(:)
integer, pointer :: distDimLocal(:)
integer, pointer :: minIndexLocal(:)
integer, pointer :: maxIndexLocal(:)
type(ESMF_CoordSys_Flag) :: coordSysLocal
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Get description of index space and what's undistributed
call GetIndexSpaceArb(minIndex, maxIndex, &
arbIndexCount, arbIndexList, distDim, &
dimCount, distDimCount, isDistLocal, distDimLocal, &
minIndexLocal, maxIndexLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Create arbitrary distgrid
distgrid= ESMF_GridCreateDistgridArb(dimCount, distDimCount, isDistLocal, distDimLocal, &
minIndexLocal, maxIndexLocal, arbIndexCount, arbIndexList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(name)) then
call ESMF_DistGridSet(distgrid, name="DG-"//trim(name), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Convert coordDeps to coordDimCount and coordDimMap
allocate(coordDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimCount", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(coordDimMap(dimCount,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
call CoordInfoFromCoordDepArb(dimCount, isDistLocal, coordDep1, coordDep2, coordDep3,&
coordDimCount, coordDimMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Put minIndex, maxIndex into indexArray for create from distgrid
allocate(indexArray(2,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating indexArray", &
ESMF_CONTEXT, rcToReturn=rc)) return
indexArray(1,:)=minIndexLocal(:)
indexArray(2,:)=maxIndexLocal(:)
! Set Default coordSys
if (present(coordSys)) then
coordSysLocal=coordSys
else
coordSysLocal=ESMF_COORDSYS_SPH_DEG
endif
! Create Grid from specification -----------------------------------------------
ESMF_GridCreateNoPeriDimA=ESMF_GridCreateFrmDistGridArb( &
distgrid, indexArray, &
distDim=distDimLocal, &
coordSys=coordSysLocal, &
coordTypeKind=coordTypeKind, &
coordDimCount=coordDimCount, coordDimMap=coordDimMap, &
name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set internal items to be destroyed with grid
call ESMF_GridSetDestroyDistgrid(ESMF_GridCreateNoPeriDimA,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout(ESMF_GridCreateNoPeriDimA,destroy=.false., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
deallocate(isDistLocal)
deallocate(indexArray)
deallocate(distDimLocal)
deallocate(coordDimCount)
deallocate(coordDimMap)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreateNoPeriDimA
!------------------------------------------------------------------------------
!!!!!!!!!!!!!! Internal Grid Method !!!!!!!!!!!!!!!!!
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateXPeriDimUfrm"
! NOTE: Right now this method has been setup to work with the
! default padding for all staggers (e.g. extra padding on
! the top). If the input Grid becomes more general then
! this method will have to be made more general as well.
subroutine ESMF_GridFillStaggerCoordsUfrm(grid, &
minCornerCoord, maxCornerCoord, staggerloc, &
rc)
type(ESMF_Grid), intent(in) :: grid
real(ESMF_KIND_R8), intent(in) :: minCornerCoord(:)
real(ESMF_KIND_R8), intent(in) :: maxCornerCoord(:)
type(ESMF_StaggerLoc), intent(in) :: staggerloc
integer, intent(out), optional :: rc
integer :: localrc
integer :: lDE, localDECount
integer :: clbnd(ESMF_MAXDIM), cubnd(ESMF_MAXDIM), i
real(ESMF_KIND_R8), pointer :: coordPtr(:)
integer :: d, dimCount, loc
real(ESMF_KIND_R8) :: p, p_plus1
real(ESMF_KIND_R8) :: hcornerIndexDiffR8
integer :: staggerMinIndex(ESMF_MAXDIM)
integer :: staggerMaxIndex(ESMF_MAXDIM)
integer :: hcornerMinIndex(ESMF_MAXDIM)
integer :: hcornerMaxIndex(ESMF_MAXDIM)
integer :: centerMinIndex(ESMF_MAXDIM)
integer :: centerMaxIndex(ESMF_MAXDIM)
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Get number of local DEs and dimCount
call ESMF_GridGet(grid, localDECount=localDECount, dimCount=dimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Calculate hypothetical span of corner index space without
! padding. To do this get corner min and add number of corners
! (which is the number of cells (center stagger) plus 1 in each dimension)
call ESMF_GridGet(grid,1,ESMF_STAGGERLOC_CENTER, &
minIndex=centerMinIndex, maxIndex=centerMaxIndex, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGet(grid,1,ESMF_STAGGERLOC_CORNER, &
minIndex=hcornerMinIndex, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Compute hypothetical corner span
! use minCorners + off set of number of cells + 1
do d=1,dimCount
hcornerMaxIndex(d)=hcornerMinIndex(d)+ &
(centerMaxIndex(d)-centerMinIndex(d))+1
enddo
! Add coordinates
call ESMF_GridAddCoord(grid, staggerloc=staggerloc, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get the min and max indices for this stagger
! Assuming 1 tile (because we're building the grid that way above)
call ESMF_GridGet(grid,1,staggerloc, &
minIndex=staggerMinIndex, maxIndex=staggerMaxIndex, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Loop through dimensions setting coordinates
do d=1,dimCount
! Get the location in the cell of this dimension in the stagger
call ESMF_StaggerLocGet(staggerloc, d, loc, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Compute width of corner index space
hcornerIndexDiffR8=REAL(hcornerMaxIndex(d)-hcornerMinIndex(d),ESMF_KIND_R8)
! Loop through DEs setting coordinates
do lDE=0,localDECount-1
! Get coordinate memory
call ESMF_GridGetCoord(grid, localDE=lDE, staggerLoc=staggerloc, coordDim=d, &
computationalLBound=clbnd, computationalUBound=cubnd, farrayPtr=coordPtr, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set each coordinates for this dim
do i=clbnd(1),cubnd(1)
! Compute [0.0,1.0] parametric position of this coord
p=REAL(i-hcornerMinIndex(d),ESMF_KIND_R8)/hcornerIndexDiffR8
! If stagger is in the center of this dim, then compute p in
! the center
if (loc .eq. 0) then
p_plus1=REAL(i+1-hcornerMinIndex(d),ESMF_KIND_R8)/hcornerIndexDiffR8
p=(p+p_plus1)/2.0_ESMF_KIND_R8
endif
! Compute value of coord based on parametric position
coordPtr(i)=minCornerCoord(d)*(1.0-p)+maxCornerCoord(d)*p
enddo
enddo
enddo
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridFillStaggerCoordsUfrm
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreate1PeriDimUfrmR"
!BOP
! !IROUTINE: ESMF_GridCreate1PeriDimUfrm - Create a uniform Grid with one periodic dim and a regular distribution
! !INTERFACE:
! Private name; call using ESMF_GridCreate1PeriDimUfrm()
function ESMF_GridCreate1PeriDimUfrmR(minIndex, maxIndex, &
minCornerCoord, maxCornerCoord, &
keywordEnforcer, regDecomp, decompFlag, &
polekindflag, coordSys, staggerLocList, &
ignoreNonPeriCoord, petMap, name, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreate1PeriDimUfrmR
!
! !ARGUMENTS:
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: maxIndex(:)
real(ESMF_KIND_R8), intent(in) :: minCornerCoord(:)
real(ESMF_KIND_R8), intent(in) :: maxCornerCoord(:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(in), optional :: regDecomp(:)
type(ESMF_Decomp_Flag), intent(in), optional :: decompflag(:)
type(ESMF_PoleKind_Flag), intent(in), optional :: polekindflag(2)
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_StaggerLoc), intent(in), optional :: staggerLocList(:)
logical, intent(in), optional :: ignoreNonPeriCoord
integer, intent(in), optional :: petMap(:,:,:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method creates a single tile, regularly distributed grid
! (see Figure \ref{fig:GridDecomps}) with one periodic dimension.
! The periodic dimension in the resulting grid will be dimension 1.
! The dimension with the poles at either end (i.e. the pole dimension)
! will be dimension 2.
!
! The grid will have its coordinates uniformly spread between the
! ranges specified by the user. The coordinates are ESMF\_TYPEKIND\_R8.
! Currently, this method only fills the center stagger with coordinates, and
! the {\tt minCornerCoord} and {\tt maxCornerCoord} arguments give the boundaries of
! the center stagger.
!
! To specify the distribution, the user passes in an array
! ({\tt regDecomp}) specifying the number of DEs to divide each
! dimension into. The array {\tt decompFlag} indicates how the division into DEs is to
! occur. The default is to divide the range as evenly as possible. Currently this call
! only supports creating a 2D or 3D Grid, and thus, for example, {\tt maxIndex} must be of size 2 or 3.
!
! The following arguments have been set to non-typical values and so
! there is a reasonable possibility that they may change in the future
! to be inconsistent with other Grid create interfaces:
!
! The arguments coordDep1, coordDep2, and coordDep3 have internally
! been set to 1, 2, and 3 respectively.
! This was done because this call creates a uniform grid and so only 1D arrays
! are needed to hold the coordinates. This means the coordinate arrays
! will be 1D.
!
! The argument indexFlag has internally been set to ESMF\_INDEX\_GLOBAL. This
! means that the grid created from this function will have a global index space.
!
! The arguments are:
! \begin{description}
! \item[{[minIndex]}]
! The bottom extent of the grid array. If not given then the value defaults
! to /1,1,1,.../.
! \item[maxIndex]
! The upper extent of the grid array.
! \item[minCornerCoord]
! The coordinates of the corner of the grid that corresponds to {\tt minIndex}.
! size(minCornerCoord) must be equal to size(maxIndex).
! \item[maxCornerCoord]
! The coordinates of the corner of the grid that corresponds to {\tt maxIndex}.
! size(maxCornerCoord) must be equal to size(maxIndex).
! \item[{[regDecomp]}]
! A ndims-element array specifying how the grid is decomposed.
! Each entry is the number of decounts for that dimension.
! \item[{[decompflag]}]
! List of decomposition flags indicating how each dimension of the
! tile is to be divided between the DEs. The default setting
! is {\tt ESMF\_DECOMP\_BALANCED} in all dimensions. Please see
! Section~\ref{const:decompflag} for a full description of the
! possible options. Note that currently the option
! {\tt ESMF\_DECOMP\_CYCLIC} isn't supported in Grid creation.
! \item[{[polekindflag]}]
! Two item array which specifies the type of connection which occurs at the pole. The value in polekindflag(1)
! specifies the connection that occurs at the minimum end of the pole dimension. The value in polekindflag(2)
! specifies the connection that occurs at the maximum end of the pole dimension. Please see
! Section~\ref{const:polekind} for a full list of options. If not specified,
! the default is {\tt ESMF\_POLEKIND\_MONOPOLE} for both.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! For a full list of options, please see Section~\ref{const:coordsys}.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[staggerLocList]}]
! The list of stagger locations to fill with coordinates. Please see Section~\ref{const:staggerloc}
! for a description of the available stagger locations. If not present, then
! no staggers are added or filled.
! \item[{[ignoreNonPeriCoord]}]
! If .true., do not check if the coordinates for the periodic dimension (i.e. dim=1) specify a full periodic range (e.g. 0 to 360 degrees).
! If not specified, defaults to .false. .
! \item[{[petMap]}]
! Sets the mapping of pets to the created DEs. This 3D
! should be of size regDecomp(1) x regDecomp(2) x regDecomp(3)
! If the Grid is 2D, then the last dimension is of size 1.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_Grid) :: grid
integer :: localrc
integer :: dimCount
integer :: s
logical :: localIgnoreNonPeriCoord
type(ESMF_CoordSys_Flag) :: localCoordSys
real(ESMF_KIND_R8), parameter :: PiX2= &
6.2831853071795862319959269370883703232_ESMF_KIND_R8
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Create grid structure
if (size(maxIndex) < 3) then
grid=ESMF_GridCreate1PeriDim(regDecomp=regDecomp, &
decompFlag=decompFlag, &
minIndex=minIndex, &
maxIndex=maxIndex, &
coordSys=coordSys, &
coordTypeKind=ESMF_TYPEKIND_R8, &
polekindflag=polekindflag, &
coordDep1=(/1/), &
coordDep2=(/2/), &
indexFlag=ESMF_INDEX_GLOBAL, &
petMap=petMap, &
name=name, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
grid=ESMF_GridCreate1PeriDim(regDecomp=regDecomp, &
decompFlag=decompFlag, &
minIndex=minIndex, &
maxIndex=maxIndex, &
coordSys=coordSys, &
coordTypeKind=ESMF_TYPEKIND_R8, &
polekindflag=polekindflag, &
coordDep1=(/1/), &
coordDep2=(/2/), &
coordDep3=(/3/), &
indexFlag=ESMF_INDEX_GLOBAL, &
petMap=petMap, &
name=name, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Get CoordSys of Grid
call ESMF_GridGet(grid, coordSys=localCoordSys, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Handle optional ignoreNonPeriCoord argument
if (present(ignoreNonPeriCoord)) then
localIgnoreNonPeriCoord=ignoreNonPeriCoord
else
localIgnoreNonPeriCoord=.false.
endif
! Make sure periodic dimension has periodic coords
if (.not. localIgnoreNonPeriCoord) then
if (localCoordSys .eq. ESMF_COORDSYS_SPH_DEG) then
if (abs(abs(maxCornerCoord(1) - minCornerCoord(1))- &
360.0_ESMF_KIND_R8) > Tiny(maxCornerCoord(1))) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_VALUE, &
msg=" coords in periodic dim (i.e. 1) are not periodic "// &
"(i.e. max coord(1)-min coord(1) /= 360)", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else if (coordSys .eq. ESMF_COORDSYS_SPH_RAD) then
if (abs(abs(maxCornerCoord(1) - minCornerCoord(1))- &
PiX2) > Tiny(maxCornerCoord(1))) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_VALUE, &
msg=" coords in periodic dim (i.e. 1) are not periodic "// &
"(i.e. max coord(1)-min coord(1) /= 2Pi)", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
! Get dimCount
call ESMF_GridGet(grid, dimCount=dimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Check size of coordinate arrays
if (size(minCornerCoord) .ne. dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- minCornerCoord array must be the same dimension as the grid (i.e. maxIndex)", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (size(maxCornerCoord) .ne. dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- maxCornerCoord array must be the same dimension as the grid (i.e. maxIndex)", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Fill staggers
if (present(staggerLocList)) then
do s=1, size(staggerLocList)
call ESMF_GridFillStaggerCoordsUfrm(grid, &
minCornerCoord, maxCornerCoord, &
staggerloc=staggerLocList(s), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
endif
! Set Grid
ESMF_GridCreate1PeriDimUfrmR=grid
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreate1PeriDimUfrmR
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreate1PeriDimUfrmB"
!BOP
! !IROUTINE: ESMF_GridCreate1PeriDimUfrm - Create a uniform Grid with one periodic dim and a block distribution
! !INTERFACE:
! Private name; call using ESMF_GridCreate1PeriDimUfrm()
function ESMF_GridCreate1PeriDimUfrmB(minIndex, maxIndex, &
minCornerCoord, maxCornerCoord, &
deBlockList, deLabelList, &
polekindflag, coordSys, staggerLocList, &
ignoreNonPeriCoord, petMap, name, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreate1PeriDimUfrmB
!
! !ARGUMENTS:
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: maxIndex(:)
real(ESMF_KIND_R8), intent(in) :: minCornerCoord(:)
real(ESMF_KIND_R8), intent(in) :: maxCornerCoord(:)
integer, intent(in) :: deBlockList(:,:,:)
integer, intent(in), optional :: deLabelList(:)
type(ESMF_PoleKind_Flag), intent(in), optional :: polekindflag(2)
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_StaggerLoc), intent(in), optional :: staggerLocList(:)
logical, intent(in), optional :: ignoreNonPeriCoord
integer, intent(in), optional :: petMap(:,:,:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method creates a single tile, regularly distributed grid
! (see Figure \ref{fig:GridDecomps}) with one periodic dimension.
! The periodic dimension in the resulting grid will be dimension 1.
! The dimension with the poles at either end (i.e. the pole dimension)
! will be dimension 2.
!
! The grid will have its coordinates uniformly spread between the
! ranges specified by the user. The coordinates are ESMF\_TYPEKIND\_R8.
! Currently, this method only fills the center stagger with coordinates, and
! the {\tt minCornerCoord} and {\tt maxCornerCoord} arguments give the boundaries of
! the center stagger.
!
! To specify the distribution, the user passes in an array
! ({\tt deBlockList}) specifying index space blocks for each DE.
!
! The following arguments have been set to non-typical values and so
! there is a reasonable possibility that they may change in the future
! to be inconsistent with other Grid create interfaces:
!
! The arguements coordDep1, coordDep2, and coordDep3 have internally
! been set to 1, 2, and 3 respectively.
! This was done because this call creates a uniform grid and so only 1D arrays
! are needed to hold the coordinates. This means the coordinate arrays
! will be 1D.
!
! The argument indexFlag has internally been set to ESMF\_INDEX\_GLOBAL. This
! means that the grid created from this function will have a global index space.
!
! The arguments are:
! \begin{description}
! \item[{[minIndex]}]
! The bottom extent of the grid array. If not given then the value defaults
! to /1,1,1,.../.
! \item[maxIndex]
! The upper extent of the grid array.
! \item[minCornerCoord]
! The coordinates of the corner of the grid that corresponds to {\tt minIndex}.
! size(minCornerCoord) must be equal to size(maxIndex).
! \item[maxCornerCoord]
! The coordinates of the corner of the grid that corresponds to {\tt maxIndex}.
! size(maxCornerCoord) must be equal to size(maxIndex).
! \item[deBlockList]
! List of DE-local LR blocks. The third index of {\tt deBlockList}
! steps through the deBlock elements, which are defined by the first
! two indices. The first index must be of size {\tt dimCount} and the
! second index must be of size 2. Each 2D element of {\tt deBlockList}
! defined by the first two indices hold the following information.
! \begin{verbatim}
! +---------------------------------------> 2nd index
! | 1 2
! | 1 minIndex(1) maxIndex(1)
! | 2 minIndex(2) maxIndex(2)
! | . minIndex(.) maxIndex(.)
! | .
! v
! 1st index
! \end{verbatim}
! It is required that there be no overlap between the LR segments
! defined by deBlockList.
! \item[{[deLabelList]}]
! List assigning DE labels to the default sequence of DEs. The default
! sequence is given by the order of DEs in the {\tt deBlockList}
! argument.
! \item[{[polekindflag]}]
! Two item array which specifies the type of connection which occurs at the pole. The value in polekindflag(1)
! specifies the connection that occurs at the minimum end of the pole dimension. The value in polekindflag(2)
! specifies the connection that occurs at the maximum end of the pole dimension. Please see
! Section~\ref{const:polekind} for a full list of options. If not specified,
! the default is {\tt ESMF\_POLEKIND\_MONOPOLE} for both.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! For a full list of options, please see Section~\ref{const:coordsys}.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[staggerLocList]}]
! The list of stagger locations to fill with coordinates. Please see Section~\ref{const:staggerloc}
! for a description of the available stagger locations. If not present, then
! no staggers are added or filled.
! \item[{[ignoreNonPeriCoord]}]
! If .true., do not check if the coordinates for the periodic dimension (i.e. dim=1) specify a full periodic range (e.g. 0 to 360 degrees).
! If not specified, defaults to .false. .
! \item[{[petMap]}]
! Sets the mapping of pets to the created DEs. This 3D
! should be of size regDecomp(1) x regDecomp(2) x regDecomp(3)
! If the Grid is 2D, then the last dimension is of size 1.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
! local variables
type(ESMF_Grid) :: grid
type(ESMF_DistGrid) :: distgrid
type(ESMF_DistGridConnection), allocatable :: connectionList(:)
integer, allocatable :: minIndexOpt(:)
integer, allocatable :: coordDimMap(:,:)
integer :: localrc
integer :: dimCount
integer :: s
logical :: localIgnoreNonPeriCoord
type(ESMF_CoordSys_Flag) :: localCoordSys
real(ESMF_KIND_R8), parameter :: PiX2= &
6.2831853071795862319959269370883703232_ESMF_KIND_R8
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Create grid structure from DistGrid with one periodic connection
dimCount = size(maxIndex)
allocate(minIndexOpt(dimCount))
if (.not.present(minIndex)) then
minIndexOpt(:) = 1 ! initialize all 1's
else
minIndexOpt = minIndex
endif
! periodic along i
allocate(connectionList(1))
call ESMF_DistGridConnectionSet(connection=connectionList(1), &
tileIndexA=1, tileIndexB=1, &
positionVector=(/maxIndex(1)-minIndexOpt(1)+1, 0/), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
distgrid = ESMF_DistGridCreate(minIndexOpt, maxIndex, &
deBlockList=deBlockList, deLabelList=deLabelList, &
connectionList=connectionList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(name)) then
call ESMF_DistGridSet(distgrid, name="DG-"//trim(name), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
allocate(coordDimMap(dimCount,dimCount))
coordDimMap = reshape((/1,2,0,0/), shape(coordDimMap))
grid = ESMF_GridCreate(distgrid, &
coordSys=coordSys, &
coordDimCount=(/1,1/), coordDimMap=coordDimMap, &
coordTypeKind=ESMF_TYPEKIND_R8, &
indexFlag=ESMF_INDEX_GLOBAL, &
name=name, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get CoordSys of Grid
call ESMF_GridGet(grid, coordSys=localCoordSys, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Handle optional ignoreNonPeriCoord argument
if (present(ignoreNonPeriCoord)) then
localIgnoreNonPeriCoord=ignoreNonPeriCoord
else
localIgnoreNonPeriCoord=.false.
endif
! Make sure periodic dimension has periodic coords
if (.not. localIgnoreNonPeriCoord) then
if (localCoordSys .eq. ESMF_COORDSYS_SPH_DEG) then
if (abs(abs(maxCornerCoord(1) - minCornerCoord(1))- &
360.0_ESMF_KIND_R8) > Tiny(maxCornerCoord(1))) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_VALUE, &
msg=" coords in periodic dim (i.e. 1) are not periodic "// &
"(i.e. max coord(1)-min coord(1) /= 360)", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else if (coordSys .eq. ESMF_COORDSYS_SPH_RAD) then
if (abs(abs(maxCornerCoord(1) - minCornerCoord(1))- &
PiX2) > Tiny(maxCornerCoord(1))) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_VALUE, &
msg=" coords in periodic dim (i.e. 1) are not periodic "// &
"(i.e. max coord(1)-min coord(1) /= 2Pi)", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
! Get dimCount
call ESMF_GridGet(grid, dimCount=dimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Check size of coordinate arrays
if (size(minCornerCoord) .ne. dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- minCornerCoord array must be the same dimension as the grid (i.e. maxIndex)", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (size(maxCornerCoord) .ne. dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- maxCornerCoord array must be the same dimension as the grid (i.e. maxIndex)", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Fill staggers
if (present(staggerLocList)) then
do s=1, size(staggerLocList)
call ESMF_GridFillStaggerCoordsUfrm(grid, &
minCornerCoord, maxCornerCoord, &
staggerloc=staggerLocList(s), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
endif
! Set Grid
ESMF_GridCreate1PeriDimUfrmB=grid
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreate1PeriDimUfrmB
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateNoPeriDimUfrmR"
!BOP
! !IROUTINE: ESMF_GridCreateNoPeriDimUfrm - Create a uniform Grid with no periodic dim and a regular distribution
! !INTERFACE:
! Private name; call using ESMF_GridCreateNoPeriDimUfrm()
function ESMF_GridCreateNoPeriDimUfrmR(minIndex, maxIndex, &
minCornerCoord, maxCornerCoord, &
keywordEnforcer, regDecomp, decompFlag, &
coordSys, staggerLocList, petMap, name, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateNoPeriDimUfrmR
!
! !ARGUMENTS:
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: maxIndex(:)
real(ESMF_KIND_R8), intent(in) :: minCornerCoord(:)
real(ESMF_KIND_R8), intent(in) :: maxCornerCoord(:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(in), optional :: regDecomp(:)
type(ESMF_Decomp_Flag), intent(in), optional :: decompflag(:)
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_StaggerLoc), intent(in), optional :: staggerLocList(:)
integer, intent(in), optional :: petMap(:,:,:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method creates a single tile, regularly distributed grid
! (see Figure \ref{fig:GridDecomps}) with no periodic dimension.
!
! The resulting grid will have its coordinates uniformly spread between the
! ranges specified by the user. The coordinates are ESMF\_TYPEKIND\_R8.
! Currently, this method only fills the center stagger with coordinates, and
! the {\tt minCornerCoord} and {\tt maxCornerCoord} arguments give the boundaries of
! the center stagger.
!
! To specify the distribution, the user passes in an array
! ({\tt regDecomp}) specifying the number of DEs to divide each
! dimension into. The array {\tt decompFlag} indicates how the division into DEs is to
! occur. The default is to divide the range as evenly as possible. Currently this call
! only supports creating a 2D or 3D Grid, and thus, for example, {\tt maxIndex} must be of size 2 or 3.
!
! The following arguments have been set to non-typical values and so
! there is a reasonable possibility that they may change in the future
! to be inconsistent with other Grid create interfaces:
!
! The arguements coordDep1, coordDep2, and coordDep3 have internally
! been set to 1, 2, and 3 respectively.
! This was done because this call creates a uniform grid and so only 1D arrays
! are needed to hold the coordinates. This means the coordinate arrays
! will be 1D.
!
! The argument indexFlag has internally been set to ESMF\_INDEX\_GLOBAL. This
! means that the grid created from this function will have a global index space.
!
! The arguments are:
! \begin{description}
! \item[{[minIndex]}]
! The bottom extent of the grid array. If not given then the value defaults
! to /1,1,1,.../.
! \item[maxIndex]
! The upper extent of the grid array.
! \item[minCornerCoord]
! The coordinates of the corner of the grid that corresponds to {\tt minIndex}.
! size(minCornerCoord) must be equal to size(maxIndex).
! \item[maxCornerCoord]
! The coordinates of the corner of the grid that corresponds to {\tt maxIndex}.
! size(maxCornerCoord) must be equal to size(maxIndex).
! \item[{[regDecomp]}]
! A ndims-element array specifying how the grid is decomposed.
! Each entry is the number of decounts for that dimension.
! \item[{[decompflag]}]
! List of decomposition flags indicating how each dimension of the
! tile is to be divided between the DEs. The default setting
! is {\tt ESMF\_DECOMP\_BALANCED} in all dimensions. Please see
! Section~\ref{const:decompflag} for a full description of the
! possible options. Note that currently the option
! {\tt ESMF\_DECOMP\_CYCLIC} isn't supported in Grid creation.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! For a full list of options, please see Section~\ref{const:coordsys}.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[staggerLocList]}]
! The list of stagger locations to fill with coordinates. Please see Section~\ref{const:staggerloc}
! for a description of the available stagger locations. If not present, then
! no staggers are added or filled.
! \item[{[petMap]}]
! Sets the mapping of pets to the created DEs. This 3D
! should be of size regDecomp(1) x regDecomp(2) x regDecomp(3)
! If the Grid is 2D, then the last dimension is of size 1.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_Grid) :: grid
integer :: localrc
integer :: dimCount
integer :: s
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Create grid structure
if (size(maxIndex) < 3) then
grid=ESMF_GridCreateNoPeriDim(regDecomp=regDecomp, &
decompFlag=decompFlag, &
minIndex=minIndex, &
maxIndex=maxIndex, &
coordSys=coordSys, &
coordTypeKind=ESMF_TYPEKIND_R8, &
coordDep1=(/1/), &
coordDep2=(/2/), &
indexFlag=ESMF_INDEX_GLOBAL, &
petMap=petMap, &
name=name, &
rc=localrc)
else
grid=ESMF_GridCreateNoPeriDim(regDecomp=regDecomp, &
decompFlag=decompFlag, &
minIndex=minIndex, &
maxIndex=maxIndex, &
coordSys=coordSys, &
coordTypeKind=ESMF_TYPEKIND_R8, &
coordDep1=(/1/), &
coordDep2=(/2/), &
coordDep3=(/3/), &
indexFlag=ESMF_INDEX_GLOBAL, &
petMap=petMap, &
name=name, &
rc=localrc)
endif
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get dimCount
call ESMF_GridGet(grid, dimCount=dimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Check size of coordinate arrays
if (size(minCornerCoord) .ne. dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- minCornerCoord array must be the same dimension as the grid (i.e. maxIndex)", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (size(maxCornerCoord) .ne. dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- maxCornerCoord array must be the same dimension as the grid (i.e. maxIndex)", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Fill staggers
if (present(staggerLocList)) then
do s=1, size(staggerLocList)
call ESMF_GridFillStaggerCoordsUfrm(grid, &
minCornerCoord, maxCornerCoord, &
staggerloc=staggerLocList(s), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
endif
! Set Grid
ESMF_GridCreateNoPeriDimUfrmR=grid
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreateNoPeriDimUfrmR
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateShapeTileIrreg"
!BOPI
! !IROUTINE: ESMF_GridCreateShapeTile - Create a Grid with an irregular distribution
! !INTERFACE:
! Private name; call using ESMF_GridCreateShapeTile()
function ESMF_GridCreateShapeTileIrreg(coordTypeKind, minIndex, &
countsPerDEDim1,countsPerDeDim2, keywordEnforcer, &
countsPerDEDim3, &
connflagDim1, connflagDim2, connflagDim3, &
poleStaggerLoc1, poleStaggerLoc2, poleStaggerLoc3, &
bipolePos1, bipolePos2, bipolePos3, &
coordDep1, coordDep2, coordDep3, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridMemLBound, indexflag, petMap, name, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateShapeTileIrreg
!
! !ARGUMENTS:
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: countsPerDEDim1(:)
integer, intent(in) :: countsPerDEDim2(:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(in), optional :: countsPerDEDim3(:)
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim1(:) !N. IMP.
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim2(:) !N. IMP.
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim3(:) !N. IMP.
type(ESMF_StaggerLoc),intent(in),optional::poleStaggerLoc1(2)!N. IMP.
type(ESMF_StaggerLoc),intent(in),optional::poleStaggerLoc2(2)!N. IMP.
type(ESMF_StaggerLoc),intent(in),optional::poleStaggerLoc3(2)!N. IMP.
integer, intent(in), optional :: bipolePos1(2)!N. IMP.
integer, intent(in), optional :: bipolePos2(2)!N. IMP.
integer, intent(in), optional :: bipolePos3(2)!N. IMP.
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(in), optional :: gridEdgeLWidth(:)
integer, intent(in), optional :: gridEdgeUWidth(:)
integer, intent(in), optional :: gridAlign(:)
integer, intent(in), optional :: gridMemLBound(:)
type(ESMF_Index_Flag), intent(in), optional :: indexflag
integer, intent(in), optional :: petMap(:,:,:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method creates a single tile, irregularly distributed grid
! (see Figure \ref{fig:GridDecomps}).
! To specify the irregular distribution, the user passes in an array
! for each grid dimension, where the length of the array is the number
! of DEs in the dimension. Up to three dimensions can be specified,
! using the countsPerDEDim1, countsPerDEDim2, countsPerDEDim3 arguments.
! The index of each array element corresponds to a DE number. The
! array value at the index is the number of grid cells on the DE in
! that dimension. The dimCount of the grid is equal to the number of
! countsPerDEDim arrays that are specified.
!
! Section \ref{example:2DIrregUniGrid} shows an example
! of using this method to create a 2D Grid with uniformly spaced
! coordinates. This creation method can also be used as the basis for
! grids with rectilinear coordinates or curvilinear coordinates.
!
! The arguments are:
! \begin{description}
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[minIndex]}]
! Tuple to start the index ranges at. If not present, defaults
! to /1,1,1,.../.
! \item[{countsPerDEDim1}]
! This arrays specifies the number of cells per DE for index dimension 1
! for the exclusive region (the center stagger location).
! \item[{countsPerDEDim2}]
! This array specifies the number of cells per DE for index dimension 2
! for the exclusive region (center stagger location).
! \item[{[countsPerDEDim3]}]
! This array specifies the number of cells per DE for index dimension 3
! for the exclusive region (center stagger location).
! If not specified then grid is 2D.
! \item[{[connflagDim1]}]
! Fortran array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[connflagDim2]}]
! Fortran array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[connflagDim3]}]
! Fortran array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[poleStaggerLoc1]}]
! Two element array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If a pole, this describes which staggerlocation is at the pole at each end.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[poleStaggerLoc2]}]
! Two element array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If a pole, this describes which staggerlocation is at the pole at each end.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[poleStaggerLoc3]}]
! Two element array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If a pole, this describes which staggerlocation is at the pole at each end.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[bipolePos1]}]
! Two element array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If a bipole, this gives the index position of one of the poles.
! The other is half way around. If not present, the default is 1.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[bipolePos2]}]
! Two element array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If a bipole, this gives the index position of one of the poles.
! The other is half way around. If not present, the default is 1.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[bipolePos3]}]
! Two element array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If a bipole, this gives the index position of one of the poles.
! The other is half way around. If not present, the default is 1.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[coordDep1]}]
! This array specifies the dependence of the first
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the first
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep2]}]
! This array specifies the dependence of the second
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the second
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep3]}]
! This array specifies the dependence of the third
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the third
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[gridEdgeLWidth]}]
! The padding around the lower edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 0, 0, ..., 0 (all zeros).
! \item[{[gridEdgeUWidth]}]
! The padding around the upper edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 1, 1, ..., 1 (all ones).
! \item[{[gridAlign]}]
! Specification of how the stagger locations should align with the cell
! index space (can be overridden by the individual staggerAligns). If
! the gridEdgeWidths are not specified than this argument
! implies the gridEdgeWidths. If the gridEdgeWidths are specified and this argument isn't
! then this argument is implied by the gridEdgeWidths.
! If this and the gridEdgeWidths are not specified, then defaults to
! -1, -1, ..., -1 (all negative ones).
! \item[{[gridMemLBound]}]
! Specifies the lower index range of the memory of every DE in this Grid.
! Only used when indexflag is {\tt ESMF\_INDEX\_USER}. May be overridden
! by staggerMemLBound.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[petMap]}]
! \begin{sloppypar}
! Sets the mapping of pets to the created DEs. This 3D
! should be of size size(countsPerDEDim1) x size(countsPerDEDim2) x
! size(countsPerDEDim3). If countsPerDEDim3 isn't present, then
! the last dimension is of size 1.
! \end{sloppypar}
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
type(ESMF_DistGrid) :: distgrid
type(ESMF_DELayout) :: delayout
integer, pointer :: petList(:)
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer :: localrc
integer :: dimCount,i,maxSizeDEDim
integer, pointer :: distgridToGridMap(:), deDimCount(:)
integer, pointer :: minIndexLocal(:)
integer, pointer :: maxIndexLocal(:)
integer, pointer :: gridEdgeLWidthLocal(:)
integer, pointer :: gridEdgeUWidthLocal(:)
integer, pointer :: gridAlignLocal(:)
integer, pointer :: countsPerDEDim1Local(:)
integer, pointer :: countsPerDEDim2Local(:)
integer, pointer :: countsPerDEDim3Local(:)
integer, pointer :: deBlockList(:,:,:),minPerDEDim(:,:),maxPerDEDim(:,:)
integer :: deCount
integer :: d,i1,i2,i3,k
type(ESMF_GridConn_Flag) :: connflagDim1Local(2)
type(ESMF_GridConn_Flag) :: connflagDim2Local(2)
type(ESMF_GridConn_Flag) :: connflagDim3Local(2)
integer :: top
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
!DUMMY TEST TO QUIET DOWN COMPILER WARNINGS
!TODO: Remove the following test when dummy argument actually used
if (present(polestaggerloc1)) then
if (polestaggerloc1(1)==polestaggerloc1(1)) continue;
endif
!DUMMY TEST TO QUIET DOWN COMPILER WARNINGS
!TODO: Remove the following test when dummy argument actually used
if (present(polestaggerloc2)) then
if (polestaggerloc2(1)==polestaggerloc2(1)) continue;
endif
!DUMMY TEST TO QUIET DOWN COMPILER WARNINGS
!TODO: Remove the following test when dummy argument actually used
if (present(bipolepos1)) then
if (bipolepos1(1)==bipolepos1(1)) continue;
endif
!DUMMY TEST TO QUIET DOWN COMPILER WARNINGS
!TODO: Remove the following test when dummy argument actually used
if (present(bipolepos2)) then
if (bipolepos2(1)==bipolepos2(1)) continue;
endif
! Compute the Grid DimCount and Derivatives ---------------------------------------------------
! dimCount
if (present(countsPerDEDim3)) then
dimCount=3
else
dimCount=2
endif
! Argument Consistency Checking --------------------------------------------------------------
if (size(countsPerDEDim1) .lt. 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- size 0 countsPerDEDim1 not allowed", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (size(countsPerDEDim2) .lt. 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- size 0 countsPerDEDim2 not allowed", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (present(countsPerDEDim3)) then
if (size(countsPerDEDim3) .lt. 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- size 0 countsPerDEDim3 not allowed", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if ((dimCount .lt. 3) .and. present(connflagDim3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- connflagDim3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((dimCount .lt. 3) .and. present(poleStaggerLoc3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- poleStaggerLoc3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((dimCount .lt. 3) .and. present(bipolePos3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- bipolePos3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((dimCount .lt. 3) .and. present(coordDep3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- coordDep3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (present(coordDep1)) then
if ((size(coordDep1) < 1) .or. (size(coordDep1)>dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- coordDep1 size incompatible with grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(coordDep2)) then
if ((size(coordDep2) < 1) .or. (size(coordDep2)>dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- coordDep2 size incompatible with grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(coordDep3)) then
if ((size(coordDep3) < 1) .or. (size(coordDep3)>dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- coordDep3 size incompatible with grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(minIndex)) then
if (size(minIndex) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- minIndex size must equal grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(petMap)) then
if (dimCount > 2) then
if ((size(petMap,1) /= size(countsPerDEDim1)) .or. &
(size(petMap,2) /= size(countsPerDEDim2)) .or. &
(size(petMap,3) /= size(countsPerDEDim3))) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- petMap wrong size in one or more dimensions", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else
if ((size(petMap,1) /= size(countsPerDEDim1)) .or. &
(size(petMap,2) /= size(countsPerDEDim2)) .or. &
(size(petMap,3) /= 1)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- petMap wrong size in one or more dimensions", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
! Check DimCount of gridWidths and Aligns
if (present(gridEdgeLWidth)) then
if (size(gridEdgeLWidth) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridEdgeLWidth must be of size equal to Grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridEdgeUWidth)) then
if (size(gridEdgeUWidth) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridEdgeUWidth must be of size equal to Grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridAlign)) then
if (size(gridAlign) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridAlign must be of size equal to Grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! make sure connected dimensions don't have an edge width
if (present(connflagDim1)) then
if (size(connflagDim1) == 1) then
if (connflagDim1(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(1) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(1) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
else if (size(connflagDim1) == 2) then
if (connflagDim1(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(1) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
if (connflagDim1(2) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(1) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
endif
endif
! make sure connected dimensions don't have an edge width
if (present(connflagDim2)) then
if (size(connflagDim2) == 1) then
if (connflagDim2(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(2) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(2) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
else if (size(connflagDim2) == 2) then
if (connflagDim2(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(2) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
if (connflagDim2(2) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(2) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
endif
endif
! make sure connected dimensions don't have an edge width
if (present(connflagDim3)) then
if (size(connflagDim3) == 1) then
if (connflagDim3(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(3) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(3) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
else if (size(connflagDim3) == 2) then
if (connflagDim3(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(3) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
if (connflagDim3(2) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(3) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
endif
endif
! check for gridMemLBound issues
if (present(gridMemLBound)) then
if (.not. present(indexflag)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- when using gridMemLBound must specify indexflag=ESMF_INDEX_USER ", &
ESMF_CONTEXT, rcToReturn=rc)
return
else if (.not. (indexflag == ESMF_INDEX_USER)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- when using gridMemLBound must specify indexflag=ESMF_INDEX_USER ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else
if (present(indexflag)) then
if (indexflag == ESMF_INDEX_USER) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- when using indexflag=ESMF_INDEX_USER must provide gridMemLBound ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
! Check for non-valid connection types here
!TODO: Consider making some of these a separate local subroutine (particularly if you're going to
! have 3 of these ShapeCreate subroutines with only minor changes
! Copy vales for countsPerDEDim --------------------------------------------
allocate(countsPerDEDim1Local(size(countsPerDEDim1)), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating countsPerDEDim1Local", &
ESMF_CONTEXT, rcToReturn=rc)) return
countsPerDEDim1Local=countsPerDEDim1
allocate(countsPerDEDim2Local(size(countsPerDEDim2)), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating countsPerDEDim2Local", &
ESMF_CONTEXT, rcToReturn=rc)) return
countsPerDEDim2Local=countsPerDEDim2
if (dimCount > 2) then
allocate(countsPerDEDim3Local(size(countsPerDEDim3)), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating countsPerDEDim3Local", &
ESMF_CONTEXT, rcToReturn=rc)) return
countsPerDEDim3Local=countsPerDEDim3
endif
! Set Defaults -------------------------------------------------------------
! Set default for minIndex
allocate(minIndexLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(minIndex)) then
minIndexLocal(:)=minIndex(:)
else
do i=1,dimCount
minIndexLocal(i)=1
enddo
endif
! Set Default for connections (although they don't work yet in distgrid/array, so they aren't really used anywhere yet.)
if (present(connflagDim1)) then
if (size(connflagDim1) == 1) then
connflagDim1Local(1)=connflagDim1(1)
connflagDim1Local(2)=connflagDim1(1) ! if only 1 connection is specified then repeat for both ends
else if (size(connflagDim1) >= 2) then
connflagDim1Local(1)=connflagDim1(1)
connflagDim1Local(2)=connflagDim1(2)
endif
else
connflagDim1Local(1)=ESMF_GRIDCONN_NONE ! if not present then default to no connection
connflagDim1Local(2)=ESMF_GRIDCONN_NONE
endif
if (present(connflagDim2)) then
if (size(connflagDim2) == 1) then
connflagDim2Local(1)=connflagDim2(1)
connflagDim2Local(2)=connflagDim2(1) ! if only 1 connection is specified then repeat for both ends
else if (size(connflagDim2) >= 2) then
connflagDim2Local(1)=connflagDim2(1)
connflagDim2Local(2)=connflagDim2(2)
endif
else
connflagDim2Local(1)=ESMF_GRIDCONN_NONE ! if not present then default to no connection
connflagDim2Local(2)=ESMF_GRIDCONN_NONE
endif
if (present(connflagDim3)) then
if (size(connflagDim3) == 1) then
connflagDim3Local(1)=connflagDim3(1)
connflagDim3Local(2)=connflagDim3(1) ! if only 1 connection is specified then repeat for both ends
else if (size(connflagDim3) >= 2) then
connflagDim3Local(1)=connflagDim3(1)
connflagDim3Local(2)=connflagDim3(2)
endif
else
connflagDim3Local(1)=ESMF_GRIDCONN_NONE ! if not present then default to no connection
connflagDim3Local(2)=ESMF_GRIDCONN_NONE
endif
! check for not implemented functionality
if (connflagDim1Local(1) /= ESMF_GRIDCONN_NONE .or. &
connflagDim1Local(2) /= ESMF_GRIDCONN_NONE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- Only ESMF_GRIDCONN_NONE Grid connection implemented so far", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (connflagDim2Local(1) /= ESMF_GRIDCONN_NONE .or. &
connflagDim2Local(2) /= ESMF_GRIDCONN_NONE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- Only ESMF_GRIDCONN_NONE Grid connection implemented so far", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (connflagDim3Local(1) /= ESMF_GRIDCONN_NONE .or. &
connflagDim3Local(2) /= ESMF_GRIDCONN_NONE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- Only ESMF_GRIDCONN_NONE Grid connection implemented so far", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Make alterations to size due to GridEdgeWidths ----------------------------
allocate(gridEdgeLWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeLWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridEdgeUWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeUWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridAlignLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridAlignLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridLUADefault(dimCount, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridEdgeLWidthLocal, gridEdgeUWidthLocal, gridAlignLocal, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
#if 0
! Modify lower bound
do i=1,dimCount
minIndexLocal(i)=minIndexLocal(i)-gridEdgeLWidthLocal(i)
enddo
! Modify lower size
countsPerDEDim1Local(1)=countsPerDEDim1Local(1)+gridEdgeLWidthLocal(1)
countsPerDEDim2Local(1)=countsPerDEDim2Local(1)+gridEdgeLWidthLocal(2)
if (dimCount > 2) then
countsPerDEDim3Local(1)=countsPerDEDim3Local(1)+gridEdgeLWidthLocal(3)
endif
! Modify upper size
top=size(countsPerDEDim1Local)
countsPerDEDim1Local(top)=countsPerDEDim1Local(top)+gridEdgeUWidthLocal(1)
top=size(countsPerDEDim2Local)
countsPerDEDim2Local(top)=countsPerDEDim2Local(top)+gridEdgeUWidthLocal(2)
if (dimCount > 2) then
top=size(countsPerDEDim3Local)
countsPerDEDim3Local(top)=countsPerDEDim3Local(top)+gridEdgeUWidthLocal(3)
endif
#endif
! Calc minIndex,maxIndex,distgridToGridMap for DistGrid -----------------------------------
! Set default for maxIndex
allocate(maxIndexLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
maxIndexLocal(1)=sum(countsPerDEDim1Local)+minIndexLocal(1)-1
maxIndexLocal(2)=sum(countsPerDEDim2Local)+minIndexLocal(2)-1
if (dimCount > 2) then
maxIndexLocal(3)=sum(countsPerDEDim3Local)+minIndexLocal(3)-1
endif
allocate(distgridToGridMap(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating distgridToGridMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
do i=1,dimCount
distgridToGridMap(i)=i
enddo
! Setup deBlockList for DistGrid ------------------------------------------------
! count de blocks
deCount=1
deCount=deCount*size(countsPerDEDim1Local)
deCount=deCount*size(countsPerDEDim2Local)
if (dimCount > 2) then
deCount=deCount*size(countsPerDEDim3Local)
endif
! Calc the max size of a DEDim
maxSizeDEDim=1
if (size(countsPerDEDim1Local) > maxSizeDEDim) then
maxSizeDEDim=size(countsPerDEDim1Local)
endif
if (size(countsPerDEDim2Local) > maxSizeDEDim) then
maxSizeDEDim=size(countsPerDEDim2Local)
endif
if (dimCount > 2) then
if (size(countsPerDEDim3Local) > maxSizeDEDim) then
maxSizeDEDim=size(countsPerDEDim3Local)
endif
endif
! generate deblocklist
allocate(maxPerDEDim(dimCount,maxSizeDEDim), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxPerDEDim", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(minPerDEDim(dimCount,maxSizeDEDim), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minPerDEDim", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(deDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxPerDEDim", &
ESMF_CONTEXT, rcToReturn=rc)) return
! Calc the maximum end of each DE in a Dim, and the size of each DEDim
d=1
deDimCount(d)=size(countsPerDEDim1Local)
minPerDeDim(d,1)=minIndexLocal(d)
maxPerDeDim(d,1)=minIndexLocal(d)+countsPerDEDim1Local(1)-1
do i=2,deDimCount(d)
minPerDEDim(d,i)=maxPerDEDim(d,i-1)+1
maxPerDEDim(d,i)=minPerDEDim(d,i)+countsPerDEDim1Local(i)-1
enddo
d=2
deDimCount(d)=size(countsPerDEDim2Local)
minPerDeDim(d,1)=minIndexLocal(d)
maxPerDeDim(d,1)=minIndexLocal(d)+countsPerDEDim2Local(1)-1
do i=2,deDimCount(d)
minPerDEDim(d,i)=maxPerDEDim(d,i-1)+1
maxPerDEDim(d,i)=minPerDEDim(d,i)+countsPerDEDim2Local(i)-1
enddo
if (dimCount > 2) then
d=3
deDimCount(d)=size(countsPerDEDim3Local)
minPerDeDim(d,1)=minIndexLocal(d)
maxPerDeDim(d,1)=minIndexLocal(d)+countsPerDEDim3Local(1)-1
do i=2,deDimCount(d)
minPerDEDim(d,i)=maxPerDEDim(d,i-1)+1
maxPerDEDim(d,i)=minPerDEDim(d,i)+countsPerDEDim3Local(i)-1
enddo
endif
! allocate deblocklist
allocate(deBlockList(dimCount,2,deCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating deBlockList", &
ESMF_CONTEXT, rcToReturn=rc)) return
! Fill in DeBlockList
if (dimCount == 2) then
k=1
do i2=1,deDimCount(2)
do i1=1,deDimCount(1)
deBlockList(1,1,k)=minPerDEDim(1,i1)
deBlockList(1,2,k)=maxPerDEDim(1,i1)
deBlockList(2,1,k)=minPerDEDim(2,i2)
deBlockList(2,2,k)=maxPerDEDim(2,i2)
k=k+1
enddo
enddo
else if (dimCount == 3) then
k=1
do i3=1,deDimCount(3)
do i2=1,deDimCount(2)
do i1=1,deDimCount(1)
deBlockList(1,1,k)=minPerDEDim(1,i1)
deBlockList(1,2,k)=maxPerDEDim(1,i1)
deBlockList(2,1,k)=minPerDEDim(2,i2)
deBlockList(2,2,k)=maxPerDEDim(2,i2)
deBlockList(3,1,k)=minPerDEDim(3,i3)
deBlockList(3,2,k)=maxPerDEDim(3,i3)
k=k+1
enddo
enddo
enddo
endif
! do i=1,deCount
! write(*,*) i,"min=",deBlockList(:,1,i)," max=",deBlockList(:,2,i)
! enddo
! Setup Connections between tile sides ----------------------------------------
! CONNECTIONS DON'T WORK YET SO NOT IMPLEMENTED
! Process PetMap --------------------------------------------------------------
if (present(petMap)) then
!! Allocate petList
allocate(petList(deCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating petList", &
ESMF_CONTEXT, rcToReturn=rc)) return
!! copy petMap to petList
if (dimCount > 2) then
k=1
do i3=1,size(countsPerDEDim3Local)
do i2=1,size(countsPerDEDim2Local)
do i1=1,size(countsPerDEDim1Local)
petList(k)=petMap(i1,i2,i3)
k=k+1
enddo
enddo
enddo
else
k=1
do i3=1,1
do i2=1,size(countsPerDEDim2Local)
do i1=1,size(countsPerDEDim1Local)
petList(k)=petMap(i1,i2,i3)
k=k+1
enddo
enddo
enddo
endif
!! create delayout from the petList
delayout=ESMF_DELayoutCreate(petMap=petList,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! Get rid of list
deallocate(petList)
else
!! create a default delayout
delayout=ESMF_DELayoutCreate(deCount=deCount,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Create DistGrid --------------------------------------------------------------
distgrid=ESMF_DistGridCreate(minIndex=minIndexLocal, maxIndex=maxIndexLocal, &
deBlockList=deBlockList, delayout=delayout, indexflag=indexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(name)) then
call ESMF_DistGridSet(distgrid, name="DG-"//trim(name), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Convert coordDeps to coordDimCount and coordDimMap -------------------------------
allocate(coordDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimCount", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(coordDimMap(dimCount,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(coordDep1)) then
coordDimCount(1)=size(coordDep1)
coordDimMap(1,:)=0
do i=1,size(coordDep1)
coordDimMap(1,i)=coordDep1(i)
enddo
else
coordDimCount(1)=dimCount
do i=1,dimCount
coordDimMap(1,i)=i
enddo
endif
if (present(coordDep2)) then
coordDimCount(2)=size(coordDep2)
coordDimMap(2,:)=0
do i=1,size(coordDep2)
coordDimMap(2,i)=coordDep2(i)
enddo
else
coordDimCount(2)=dimCount
do i=1,dimCount
coordDimMap(2,i)=i
enddo
endif
if (dimCount > 2) then
if (present(coordDep3)) then
coordDimCount(3)=size(coordDep3)
coordDimMap(3,:)=0
do i=1,size(coordDep3)
coordDimMap(3,i)=coordDep3(i)
enddo
else
coordDimCount(3)=dimCount
do i=1,dimCount
coordDimMap(3,i)=i
enddo
endif
endif
! Create Grid from specification -----------------------------------------------
ESMF_GridCreateShapeTileIrreg=ESMF_GridCreateFrmDistGrid(distgrid, &
distgridToGridMap=distgridToGridMap, coordTypeKind=coordTypeKind, &
coordDimCount=coordDimCount, coordDimMap=coordDimMap, &
gridEdgeLWidth=gridEdgeLWidthLocal, &
gridEdgeUWidth=gridEdgeUWidthLocal, &
gridAlign=gridAlignLocal, &
gridMemLBound=gridMemLBound, &
indexflag=indexflag, &
name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set internal items to be destroyed with grid
call ESMF_GridSetDestroyDistgrid( ESMF_GridCreateShapeTileIrreg,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout( ESMF_GridCreateShapeTileIrreg,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(coordDimCount)
deallocate(coordDimMap)
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
deallocate(distgridToGridMap)
deallocate(maxPerDEDim)
deallocate(minPerDEDim)
deallocate(deDimCount)
deallocate(deBlockList)
deallocate(gridEdgeLWidthLocal)
deallocate(gridEdgeUWidthLocal)
deallocate(gridAlignLocal)
deallocate(countsPerDEDim1Local)
deallocate(countsPerDEDim2Local)
if (dimCount > 2) then
deallocate(countsPerDEDim3Local)
endif
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreateShapeTileIrreg
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateShapeTileReg"
!BOPI
! !IROUTINE: ESMF_GridCreateShapeTile - Create a Grid with a regular distribution
! !INTERFACE:
! Private name; call using ESMF_GridCreateShapeTile()
function ESMF_GridCreateShapeTileReg(coordTypeKind, &
regDecomp, decompFlag, minIndex, maxIndex, &
keywordEnforcer, connflagDim1, connflagDim2, connflagDim3, &
poleStaggerLoc1, poleStaggerLoc2, poleStaggerLoc3, &
bipolePos1, bipolePos2, bipolePos3, &
coordDep1, coordDep2, coordDep3, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridMemLBound, indexflag, petMap, name, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateShapeTileReg
!
! !ARGUMENTS:
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: regDecomp(:)
type(ESMF_Decomp_Flag), intent(in), optional :: decompflag(:)
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: maxIndex(:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim1(:) !N. IMP.
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim2(:) !N. IMP.
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim3(:) !N. IMP.
type(ESMF_StaggerLoc),intent(in),optional::poleStaggerLoc1(2)!N. IMP.
type(ESMF_StaggerLoc),intent(in),optional::poleStaggerLoc2(2)!N. IMP.
type(ESMF_StaggerLoc),intent(in),optional::poleStaggerLoc3(2)!N. IMP.
integer, intent(in), optional :: bipolePos1(2)!N. IMP.
integer, intent(in), optional :: bipolePos2(2)!N. IMP.
integer, intent(in), optional :: bipolePos3(2)!N. IMP.
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(in), optional :: gridEdgeLWidth(:)
integer, intent(in), optional :: gridEdgeUWidth(:)
integer, intent(in), optional :: gridAlign(:)
integer, intent(in), optional :: gridMemLBound(:)
type(ESMF_Index_Flag), intent(in), optional :: indexflag
integer, intent(in), optional :: petMap(:,:,:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method creates a single tile, regularly distributed grid
! (see Figure \ref{fig:GridDecomps}).
! To specify the distribution, the user passes in an array
! ({\tt regDecomp}) specifying the number of DEs to divide each
! dimension into. The array {\tt decompFlag} indicates how the division into DEs is to
! occur. The default is to divide the range as evenly as possible.
!
! The arguments are:
! \begin{description}
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[regDecomp]}]
! List that has the same number of elements as {\tt maxIndex}.
! Each entry is the number of decounts for that dimension.
! If not specified, the default decomposition will be petCountx1x1..x1.
! \item[{[decompflag]}]
! List of decomposition flags indicating how each dimension of the
! tile is to be divided between the DEs. The default setting
! is {\tt ESMF\_DECOMP\_BALANCED} in all dimensions. Please see
! Section~\ref{const:decompflag} for a full description of the
! possible options. Note that currently the option
! {\tt ESMF\_DECOMP\_CYCLIC} isn't supported in Grid creation.
! \item[{[minIndex]}]
! The bottom extent of the grid array. If not given then the value defaults
! to /1,1,1,.../.
! \item[{maxIndex}]
! The upper extent of the grid array.
! \item[{[connflagDim1]}]
! Fortran array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[connflagDim2]}]
! Fortran array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[connflagDim3]}]
! Fortran array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[poleStaggerLoc1]}]
! Two element array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If a pole, this describes which staggerlocation is at the pole at each end.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[poleStaggerLoc2]}]
! Two element array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If a pole, this describes which staggerlocation is at the pole at each end.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[poleStaggerLoc3]}]
! Two element array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If a pole, this describes which staggerlocation is at the pole at each end.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[bipolePos1]}]
! Two element array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If a bipole, this gives the index position of one of the poles.
! The other is half way around. If not present, the default is 1.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[bipolePos2]}]
! Two element array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If a bipole, this gives the index position of one of the poles.
! The other is half way around. If not present, the default is 1.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[bipolePos3]}]
! Two element array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If a bipole, this gives the index position of one of the poles.
! The other is half way around. If not present, the default is 1.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[coordDep1]}]
! This array specifies the dependence of the first
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the first
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep2]}]
! This array specifies the dependence of the second
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the second
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep3]}]
! This array specifies the dependence of the third
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the third
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[gridEdgeLWidth]}]
! The padding around the lower edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 0, 0, ..., 0 (all zeros).
! \item[{[gridEdgeUWidth]}]
! The padding around the upper edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 1, 1, ..., 1 (all ones).
! \item[{[gridAlign]}]
! Specification of how the stagger locations should align with the cell
! index space (can be overridden by the individual staggerAligns). If
! the gridEdgeWidths are not specified than this argument
! implies the gridEdgeWidths. If the gridEdgeWidths are specified and this argument isn't
! then this argument is implied by the gridEdgeWidths.
! If this and the gridEdgeWidths are not specified, then defaults to
! -1, -1, ..., -1 (all negative ones).
! \item[{[gridMemLBound]}]
! Specifies the lower index range of the memory of every DE in this Grid.
! Only used when indexflag is {\tt ESMF\_INDEX\_USER}. May be overridden
! by staggerMemLBound.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[petMap]}]
! Sets the mapping of pets to the created DEs. This 3D
! should be of size regDecomp(1) x regDecomp(2) x regDecomp(3)
! If the Grid is 2D, then the last dimension is of size 1.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
type(ESMF_DistGrid) :: distgrid
type(ESMF_DELayout) :: delayout
type(ESMF_VM) :: vm
integer, pointer :: petList(:)
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer :: localrc
integer :: dimCount,i
integer, pointer :: regDecompLocal(:)
type(ESMF_Decomp_Flag), pointer :: decompflagLocal(:)
integer, pointer :: distgridToGridMap(:)
integer, pointer :: minIndexLocal(:), maxIndexLocal(:)
integer, pointer :: gridEdgeLWidthLocal(:)
integer, pointer :: gridEdgeUWidthLocal(:)
integer, pointer :: gridAlignLocal(:)
integer :: deCount
integer :: i1,i2,i3,k
type(ESMF_GridConn_Flag) :: connflagDim1Local(2)
type(ESMF_GridConn_Flag) :: connflagDim2Local(2)
type(ESMF_GridConn_Flag) :: connflagDim3Local(2)
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
!DUMMY TEST TO QUIET DOWN COMPILER WARNINGS
!TODO: Remove the following test when dummy argument actually used
if (present(polestaggerloc1)) then
if (polestaggerloc1(1)==polestaggerloc1(1)) continue;
endif
!DUMMY TEST TO QUIET DOWN COMPILER WARNINGS
!TODO: Remove the following test when dummy argument actually used
if (present(polestaggerloc2)) then
if (polestaggerloc2(1)==polestaggerloc2(1)) continue;
endif
!DUMMY TEST TO QUIET DOWN COMPILER WARNINGS
!TODO: Remove the following test when dummy argument actually used
if (present(bipolepos1)) then
if (bipolepos1(1)==bipolepos1(1)) continue;
endif
!DUMMY TEST TO QUIET DOWN COMPILER WARNINGS
!TODO: Remove the following test when dummy argument actually used
if (present(bipolepos2)) then
if (bipolepos2(1)==bipolepos2(1)) continue;
endif
! Compute the Grid DimCount and Derivatives ---------------------------------------------------
! dimCount
dimCount=size(maxIndex)
if ((dimCount < 2) .or. (dimCount > 3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- maxIndex size and thus Grid dimCount must be either 2 or 3 when using create shape ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Argument Consistency Checking --------------------------------------------------------------
if (present(regDecomp)) then
if (size(regDecomp) .lt. dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- regDecomp size doesn't match Grid dimCount ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(decompFlag)) then
if (size(decompFlag) .lt. dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- decompFlag size doesn't match Grid dimCount ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! CYCLIC decomposition isn't allowed when creating a Grid
do i=1,size(decompFlag)
if (decompFlag(i) == ESMF_DECOMP_CYCLIC) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_OUTOFRANGE, &
msg="- decompFlag isn't allowed to be" // &
" ESMF_DECOMP_CYCLIC when creating a Grid.", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
enddo
endif
if ((dimCount .lt. 3) .and. present(connflagDim3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- connflagDim3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((dimCount .lt. 3) .and. present(poleStaggerLoc3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- poleStaggerLoc3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((dimCount .lt. 3) .and. present(bipolePos3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- bipolePos3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((dimCount .lt. 3) .and. present(coordDep3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- coordDep3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (present(coordDep1)) then
if ((size(coordDep1) < 1) .or. (size(coordDep1)>dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- coordDep1 size incompatible with grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(coordDep2)) then
if ((size(coordDep2) < 1) .or. (size(coordDep2)>dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- coordDep2 size incompatible with grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(coordDep3)) then
if ((size(coordDep3) < 1) .or. (size(coordDep3)>dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- coordDep3 size incompatible with grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(minIndex)) then
if (size(minIndex) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- minIndex size must equal grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! Check DimCount of gridWidths and Aligns
if (present(gridEdgeLWidth)) then
if (size(gridEdgeLWidth) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridEdgeLWidth must be of size equal to Grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridEdgeUWidth)) then
if (size(gridEdgeUWidth) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridEdgeUWidth must be of size equal to Grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridAlign)) then
if (size(gridAlign) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridAlign must be of size equal to Grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! make sure connected dimensions don't have an edge width
if (present(connflagDim1)) then
if (size(connflagDim1) == 1) then
if (connflagDim1(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(1) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(1) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
else if (size(connflagDim1) == 2) then
if (connflagDim1(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(1) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
if (connflagDim1(2) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(1) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
endif
endif
! make sure connected dimensions don't have an edge width
if (present(connflagDim2)) then
if (size(connflagDim2) == 1) then
if (connflagDim2(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(2) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(2) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
else if (size(connflagDim2) == 2) then
if (connflagDim2(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(2) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
if (connflagDim2(2) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(2) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
endif
endif
! make sure connected dimensions don't have an edge width
if (present(connflagDim3)) then
if (size(connflagDim3) == 1) then
if (connflagDim3(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(3) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(3) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
else if (size(connflagDim3) == 2) then
if (connflagDim3(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(3) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
if (connflagDim3(2) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(3) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
endif
endif
! check for gridMemLBound issues
if (present(gridMemLBound)) then
if (.not. present(indexflag)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- when using gridMemLBound must specify indexflag=ESMF_INDEX_USER ", &
ESMF_CONTEXT, rcToReturn=rc)
return
else if (.not.(indexflag == ESMF_INDEX_USER)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- when using gridMemLBound must specify indexflag=ESMF_INDEX_USER ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else
if (present(indexflag)) then
if (indexflag == ESMF_INDEX_USER) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- when using indexflag=ESMF_INDEX_USER must provide gridMemLBound ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
! Check for non-valid connection types here
!TODO: Consider making some of these a separate local subroutine (particularly if you're going to
! have 3 of these ShapeCreate subroutines with only minor changes
! Set Defaults ------------------------------------------------------------------
! Set default for minIndex
allocate(minIndexLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(minIndex)) then
minIndexLocal(:)=minIndex(:)
else
do i=1,dimCount
minIndexLocal(i)=1
enddo
endif
! Set default for maxIndex
allocate(maxIndexLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
maxIndexLocal(:)=maxIndex(:)
! Set default for regDecomp
allocate(regDecompLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating regDecompLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(regDecomp)) then
regDecompLocal(:)=regDecomp(:)
else
! The default is 1D divided among all the Pets
call ESMF_VMGetCurrent(vm,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_VMGet(vm,petCount=regDecompLocal(1),rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
do i=2,dimCount
regDecompLocal(i)=1
enddo
endif
! Set Default for connections (although they don't work yet in distgrid/array, so they aren't really used anywhere yet.)
if (present(connflagDim1)) then
if (size(connflagDim1) == 1) then
connflagDim1Local(1)=connflagDim1(1)
connflagDim1Local(2)=connflagDim1(1) ! if only 1 connection is specified then repeat for both ends
else if (size(connflagDim1) >= 2) then
connflagDim1Local(1)=connflagDim1(1)
connflagDim1Local(2)=connflagDim1(2)
endif
else
connflagDim1Local(1)=ESMF_GRIDCONN_NONE ! if not present then default to no connection
connflagDim1Local(2)=ESMF_GRIDCONN_NONE
endif
if (present(connflagDim2)) then
if (size(connflagDim2) == 1) then
connflagDim2Local(1)=connflagDim2(1)
connflagDim2Local(2)=connflagDim2(1) ! if only 1 connection is specified then repeat for both ends
else if (size(connflagDim2) >= 2) then
connflagDim2Local(1)=connflagDim2(1)
connflagDim2Local(2)=connflagDim2(2)
endif
else
connflagDim2Local(1)=ESMF_GRIDCONN_NONE ! if not present then default to no connection
connflagDim2Local(2)=ESMF_GRIDCONN_NONE
endif
if (present(connflagDim3)) then
if (size(connflagDim3) == 1) then
connflagDim3Local(1)=connflagDim3(1)
connflagDim3Local(2)=connflagDim3(1) ! if only 1 connection is specified then repeat for both ends
else if (size(connflagDim3) >= 2) then
connflagDim3Local(1)=connflagDim3(1)
connflagDim3Local(2)=connflagDim3(2)
endif
else
connflagDim3Local(1)=ESMF_GRIDCONN_NONE ! if not present then default to no connection
connflagDim3Local(2)=ESMF_GRIDCONN_NONE
endif
! check for not implemented functionality
if (connflagDim1Local(1) /= ESMF_GRIDCONN_NONE .or. &
connflagDim1Local(2) /= ESMF_GRIDCONN_NONE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- Only ESMF_GRIDCONN_NONE Grid connection implemented so far", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (connflagDim2Local(1) /= ESMF_GRIDCONN_NONE .or. &
connflagDim2Local(2) /= ESMF_GRIDCONN_NONE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- Only ESMF_GRIDCONN_NONE Grid connection implemented so far", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (connflagDim3Local(1) /= ESMF_GRIDCONN_NONE .or. &
connflagDim3Local(2) /= ESMF_GRIDCONN_NONE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- Only ESMF_GRIDCONN_NONE Grid connection implemented so far", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (present(petMap)) then
if (dimCount > 2) then
if ((size(petMap,1) /= regDecompLocal(1)) .or. &
(size(petMap,2) /= regDecompLocal(2)) .or. &
(size(petMap,3) /= regDecompLocal(3))) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- petMap wrong size in one or more dimensions", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else
if ((size(petMap,1) /= regDecompLocal(1)) .or. &
(size(petMap,2) /= regDecompLocal(2)) .or. &
(size(petMap,3) /= 1)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- petMap wrong size in one or more dimensions", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
! Modify Bounds by GridEdgeUWidth and GridEdgeLWidth -------------------------
! setup maxIndexLocal to hold modified bounds
allocate(gridEdgeLWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeLWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridEdgeUWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeUWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridAlignLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridAlignLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridLUADefault(dimCount, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridEdgeLWidthLocal, gridEdgeUWidthLocal, gridAlignLocal, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
#if 0
! Modify lower bound
do i=1,dimCount
minIndexLocal(i)=minIndexLocal(i)-gridEdgeLWidthLocal(i)
enddo
! Modify upper bound
do i=1,dimCount
maxIndexLocal(i)=maxIndexLocal(i)+gridEdgeUWidthLocal(i)
enddo
#endif
! Set default for decomp flag based on gridEdgeWidths -----------------------------------
! NOTE: This is a temporary fix until we have something better implemented in distGrid
! Set default for decompFlag
allocate(decompFlagLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating decompFlagLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(decompFlag)) then
decompFlagLocal(:)=decompFlag(:)
else
decompFlagLocal(:)=ESMF_DECOMP_BALANCED
endif
allocate(distgridToGridMap(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating distgridToGridMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
do i=1,dimCount
distgridToGridMap(i)=i
enddo
! Setup Connections between tile sides ----------------------------------------
! CONNECTIONS DON'T WORK YET SO NOT IMPLEMENTED
! Process PetMap --------------------------------------------------------------
!! Calculate deCount
deCount=1
do i=1,dimCount
deCount=deCount*regDecompLocal(i)
enddo
! create DELayout based on presence of petMap
if (present(petMap)) then
!! Allocate petList
allocate(petList(deCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating petList", &
ESMF_CONTEXT, rcToReturn=rc)) return
!! copy petMap to petList
if (dimCount > 2) then
k=1
do i3=1,regDecompLocal(3)
do i2=1,regDecompLocal(2)
do i1=1,regDecompLocal(1)
petList(k)=petMap(i1,i2,i3)
k=k+1
enddo
enddo
enddo
else
k=1
do i3=1,1
do i2=1,regDecompLocal(2)
do i1=1,regDecompLocal(1)
petList(k)=petMap(i1,i2,i3)
k=k+1
enddo
enddo
enddo
endif
!! create delayout from the petList
delayout=ESMF_DELayoutCreate(petMap=petList,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! Get rid of list
deallocate(petList)
else
!! create a default delayout
delayout=ESMF_DELayoutCreate(deCount=deCount,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Create DistGrid --------------------------------------------------------------
distgrid=ESMF_DistGridCreate(minIndex=minIndexLocal, maxIndex=maxIndexLocal, &
regDecomp=regDecompLocal, decompFlag=decompFlagLocal, delayout=delayout,&
indexflag=indexflag, &
#if 0
regDecompFirstExtra=gridEdgeLWidthLocal, &
regDecompLastExtra=gridEdgeUWidthLocal, &
#endif
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(name)) then
call ESMF_DistGridSet(distgrid, name="DG-"//trim(name), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Convert coordDeps to coordDimCount and coordDimMap -------------------------------
allocate(coordDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimCount", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(coordDimMap(dimCount,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(coordDep1)) then
coordDimCount(1)=size(coordDep1)
coordDimMap(1,:)=0
do i=1,size(coordDep1)
coordDimMap(1,i)=coordDep1(i)
enddo
else
coordDimCount(1)=dimCount
do i=1,dimCount
coordDimMap(1,i)=i
enddo
endif
if (present(coordDep2)) then
coordDimCount(2)=size(coordDep2)
coordDimMap(2,:)=0
do i=1,size(coordDep2)
coordDimMap(2,i)=coordDep2(i)
enddo
else
coordDimCount(2)=dimCount
do i=1,dimCount
coordDimMap(2,i)=i
enddo
endif
if (dimCount > 2) then
if (present(coordDep3)) then
coordDimCount(3)=size(coordDep3)
coordDimMap(3,:)=0
do i=1,size(coordDep3)
coordDimMap(3,i)=coordDep3(i)
enddo
else
coordDimCount(3)=dimCount
do i=1,dimCount
coordDimMap(3,i)=i
enddo
endif
endif
ESMF_GridCreateShapeTileReg=ESMF_GridCreateFrmDistGrid(distgrid, &
distgridToGridMap=distgridToGridMap, &
coordTypeKind=coordTypeKind, &
coordDimCount=coordDimCount, coordDimMap=coordDimMap, &
gridEdgeLWidth=gridEdgeLWidthLocal, &
gridEdgeUWidth=gridEdgeUWidthLocal, &
gridAlign=gridAlignLocal, &
gridMemLBound=gridMemLBound, &
indexflag=indexflag, &
name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set internal items to be destroyed with grid
call ESMF_GridSetDestroyDistgrid(ESMF_GridCreateShapeTileReg,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout(ESMF_GridCreateShapeTileReg,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(regDecompLocal)
deallocate(decompFlagLocal)
deallocate(coordDimCount)
deallocate(coordDimMap)
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
deallocate(distgridToGridMap)
deallocate(gridEdgeLWidthLocal)
deallocate(gridEdgeUWidthLocal)
deallocate(gridAlignLocal)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreateShapeTileReg
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateShapeTileArb"
!BOPI
! !IROUTINE: ESMF_GridCreateShapeTile - Create a Grid with an arbitrary distribution
! !INTERFACE:
! Private name; call using ESMF_GridCreateShapeTile()
function ESMF_GridCreateShapeTileArb(coordTypeKind, minIndex, &
maxIndex, arbIndexCount, arbIndexList, &
keywordEnforcer, connflagDim1, connflagDim2, connflagDim3, &
poleStaggerLoc1, poleStaggerLoc2, poleStaggerLoc3, &
bipolePos1, bipolePos2, bipolePos3, &
coordDep1, coordDep2, coordDep3, &
distDim, name, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateShapeTileArb
!
! !ARGUMENTS:
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: maxIndex(:)
integer, intent(in) :: arbIndexCount
integer, intent(in) :: arbIndexList(:,:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim1(:) ! N. IMP.
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim2(:) ! N. IMP.
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim3(:) ! N. IMP.
type(ESMF_StaggerLoc),intent(in),optional::poleStaggerLoc1(2)! N. IMP.
type(ESMF_StaggerLoc),intent(in),optional::poleStaggerLoc2(2)! N. IMP.
type(ESMF_StaggerLoc),intent(in),optional::poleStaggerLoc3(2)! N. IMP.
integer, intent(in), optional :: bipolePos1(2)! N. IMP.
integer, intent(in), optional :: bipolePos2(2)! N. IMP.
integer, intent(in), optional :: bipolePos3(2)! N. IMP.
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(in), optional :: distDim(:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method creates a single tile, arbitrarily distributed grid
! (see Figure \ref{fig:GridDecomps}).
! To specify the arbitrary distribution, the user passes in an 2D array
! of local indices, where the first dimension is the number of local grid cells
! specified by {\tt localArbIndexCount} and the second dimension is the number of distributed
! dimensions.
!
! {\tt distDim} specifies which grid dimensions are arbitrarily distributed. The
! size of {\tt distDim} has to agree with the size of the second dimension of
! {\tt localArbIndex}.
!
! The arguments are:
! \begin{description}
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[minIndex]}]
! Tuple to start the index ranges at. If not present, defaults
! to /1,1,1,.../.
! \item[{[maxIndex]}]
! The upper extend of the grid index ranges.
! \item[{arbIndexCount}]
! The number of grid cells in the local DE. It is okay to have 0
! grid cell in a local DE.
! \item[{[arbIndexList]}]
! This 2D array specifies the indices of the PET LOCAL grid cells. The
! dimensions should be arbIndexCount * number of Distributed grid dimensions
! where arbIndexCount is the input argument specified below
! \item[{[connflagDim1]}]
! Fortran array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[connflagDim2]}]
! Fortran array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[connflagDim3]}]
! Fortran array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[poleStaggerLoc1]}]
! Two element array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If a pole, this describes which staggerlocation is at the pole at each end.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[poleStaggerLoc2]}]
! Two element array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If a pole, this describes which staggerlocation is at the pole at each end.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[poleStaggerLoc3]}]
! Two element array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If a pole, this describes which staggerlocation is at the pole at each end.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[bipolePos1]}]
! Two element array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If a bipole, this gives the index position of one of the poles.
! The other is half way around. If not present, the default is 1.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[bipolePos2]}]
! Two element array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If a bipole, this gives the index position of one of the poles.
! The other is half way around. If not present, the default is 1.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[bipolePos3]}]
! Two element array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If a bipole, this gives the index position of one of the poles.
! The other is half way around. If not present, the default is 1.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[coordDep1]}]
! The size of the array specifies the number of dimensions of the
! first coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. The format should be /ESMF\_DIM\_ARB/ where
! /ESMF\_DIM\_ARB/ is mapped to the collapsed 1D dimension from all
! the arbitrarily distributed dimensions. n is the dimension that
! is not distributed (if exists).
! If not present the default is /ESMF\_DIM\_ARB/ if the first dimension
! is arbitararily distributed, or /n/ if not distributed (i.e. n=1)
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_DIM\_ARB.
! \item[{[coordDep2]}]
! The size of the array specifies the number of dimensions of the
! second coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. The format should be /ESMF\_DIM\_ARB/ where
! /ESMF\_DIM\_ARB/ is mapped to the collapsed 1D dimension from all
! the arbitrarily distributed dimensions. n is the dimension that
! is not distributed (if exists).
! If not present the default is /ESMF\_DIM\_ARB/ if this dimension
! is arbitararily distributed, or /n/ if not distributed (i.e. n=2)
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_DIM\_ARB.
! \item[{[coordDep3]}]
! The size of the array specifies the number of dimensions of the
! third coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. The format should be /ESMF\_DIM\_ARB/ where
! /ESMF\_DIM\_ARB/ is mapped to the collapsed 1D dimension from all
! the arbitrarily distributed dimensions. n is the dimension that
! is not distributed (if exists).
! If not present the default is /ESMF\_DIM\_ARB/ if this dimension
! is arbitararily distributed, or /n/ if not distributed (i.e. n=3)
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_DIM\_ARB.
! \item[{[distDim]}]
! This array specifies which dimensions are arbitrarily distributed.
! The size of the array specifies the total distributed dimensions.
! if not specified, defaults is all dimensions will be arbitrarily
! distributed. The size has to agree with the size of the second
! dimension of {\tt localArbIndex}.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
type(ESMF_DistGrid) :: distgrid
integer, pointer :: undistLBound(:)
integer, pointer :: undistUBound(:)
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer :: localrc
integer :: dimCount,distDimCount,undistDimCount
integer, pointer :: indexArray(:,:)
integer :: i,j,ud
type(ESMF_GridConn_Flag) :: connflagDim1Local(2)
type(ESMF_GridConn_Flag) :: connflagDim2Local(2)
type(ESMF_GridConn_Flag) :: connflagDim3Local(2)
integer, pointer :: distSize(:)
integer, pointer :: distDimLocal(:)
logical, pointer :: isDist(:)
integer, pointer :: local1DIndices(:)
integer :: ind
logical :: found
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
!DUMMY TEST TO QUIET DOWN COMPILER WARNINGS
!TODO: Remove the following test when dummy argument actually used
if (present(polestaggerloc1)) then
if (polestaggerloc1(1)==polestaggerloc1(1)) continue;
endif
!DUMMY TEST TO QUIET DOWN COMPILER WARNINGS
!TODO: Remove the following test when dummy argument actually used
if (present(polestaggerloc2)) then
if (polestaggerloc2(1)==polestaggerloc2(1)) continue;
endif
!DUMMY TEST TO QUIET DOWN COMPILER WARNINGS
!TODO: Remove the following test when dummy argument actually used
if (present(bipolepos1)) then
if (bipolepos1(1)==bipolepos1(1)) continue;
endif
!DUMMY TEST TO QUIET DOWN COMPILER WARNINGS
!TODO: Remove the following test when dummy argument actually used
if (present(bipolepos2)) then
if (bipolepos2(1)==bipolepos2(1)) continue;
endif
! Compute the Grid DimCount and Derivatives ---------------------------------------------------
! dimCount
dimCount=size(maxIndex)
if ((dimCount < 2) .or. (dimCount > 3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- maxIndex size and thus Grid dimCount must be either 2 or 3 when using create shape ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! number of distributed dimension, distDimCount, is determined by the second dim of
! localArbIndex
distDimCount = size(arbIndexList,2)
if (distDimCount > dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- the second dim of localArbIndex must be equal or less than grid dimension", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
allocate(distDimLocal(distDimCount), stat=localrc)
allocate(isDist(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating distDimLocal or isDist", &
ESMF_CONTEXT, rcToReturn=rc)) return
isDist(:)=.false.
! check distribution info
if (present(distDim)) then
if (size(distDim) /= distDimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- distDim must match with the second dimension of localArbIndex", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
distDimLocal(:)=distDim(:)
do i=1,distDimCount
isDist(distDimLocal(i))=.true.
enddo
else
do i=1,distDimCount
distDimLocal(i)=i
enddo
isDist(1:distDimCount)=.true.
endif
! Argument Consistency Checking --------------------------------------------------------------
if ((dimCount .lt. 3) .and. present(connflagDim3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- connflagDim3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((dimCount .lt. 3) .and. present(poleStaggerLoc3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- poleStaggerLoc3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((dimCount .lt. 3) .and. present(bipolePos3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- bipolePos3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (present(minIndex)) then
if (size(minIndex) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- minIndex size must equal grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! Check for non-valid connection types here
! Set Defaults -------------------------------------------------------------
! Set default for minIndex
allocate(indexArray(2,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(minIndex)) then
indexArray(1,:)=minIndex(:)
else
indexArray(1,:)=1
endif
! Set default for maxIndex
indexArray(2,:)=maxIndex(:)
! dimCount of distributed part
allocate(distSize(distDimCount),stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating distSize", &
ESMF_CONTEXT, rcToReturn=rc)) return
do i=1,distDimCount
ind = distDimLocal(i)
distSize(i)=indexArray(2,ind)-indexArray(1,ind)+1
enddo
! dimCounts of the undistributed part of the grid
undistDimCount=dimCount-distDimCount
! can't have all undistributed dimensions
if (distDimCount == 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Need to have at least one distributed dimension", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! convert localArbIndex into 1D index array for DistGrid
! Check localArbIndex dimension matched with localArbIndexCount and diskDimCount
if (size(arbIndexList, 1) /= arbIndexCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- localArbIndex 1st dimension has to match with localArbIndexCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
allocate(local1DIndices(arbIndexCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating local1DIndices", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (arbIndexCount > 0) then
! use 0-based index to calculate the 1D index and add 1 back at the end
do i = 1, arbIndexCount
local1DIndices(i) = arbIndexList(i,1)-1
if (distDimCount >= 2) then
do j = 2,distDimCount
local1DIndices(i) = local1DIndices(i)*distSize(j) + arbIndexList(i,j)-1
enddo
endif
local1DIndices(i) = local1DIndices(i)+1
enddo
endif
! Set Default for connections (although they don't work yet in distgrid/array, so they aren't really used anywhere yet.)
if (present(connflagDim1)) then
if (size(connflagDim1) == 1) then
connflagDim1Local(1)=connflagDim1(1)
connflagDim1Local(2)=connflagDim1(1) ! if only 1 connection is specified then repeat for both ends
else if (size(connflagDim1) >= 2) then
connflagDim1Local(1)=connflagDim1(1)
connflagDim1Local(2)=connflagDim1(2)
endif
else
connflagDim1Local(1)=ESMF_GRIDCONN_NONE ! if not present then default to no connection
connflagDim1Local(2)=ESMF_GRIDCONN_NONE
endif
if (present(connflagDim2)) then
if (size(connflagDim2) == 1) then
connflagDim2Local(1)=connflagDim2(1)
connflagDim2Local(2)=connflagDim2(1) ! if only 1 connection is specified then repeat for both ends
else if (size(connflagDim2) >= 2) then
connflagDim2Local(1)=connflagDim2(1)
connflagDim2Local(2)=connflagDim2(2)
endif
else
connflagDim2Local(1)=ESMF_GRIDCONN_NONE ! if not present then default to no connection
connflagDim2Local(2)=ESMF_GRIDCONN_NONE
endif
if (present(connflagDim3)) then
if (size(connflagDim3) == 1) then
connflagDim3Local(1)=connflagDim3(1)
connflagDim3Local(2)=connflagDim3(1) ! if only 1 connection is specified then repeat for both ends
else if (size(connflagDim3) >= 2) then
connflagDim3Local(1)=connflagDim3(1)
connflagDim3Local(2)=connflagDim3(2)
endif
else
connflagDim3Local(1)=ESMF_GRIDCONN_NONE ! if not present then default to no connection
connflagDim3Local(2)=ESMF_GRIDCONN_NONE
endif
! check for not implemented functionality
if (connflagDim1Local(1) /= ESMF_GRIDCONN_NONE .or. &
connflagDim1Local(2) /= ESMF_GRIDCONN_NONE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- Only ESMF_GRIDCONN_NONE Grid connection implemented so far", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (connflagDim2Local(1) /= ESMF_GRIDCONN_NONE .or. &
connflagDim2Local(2) /= ESMF_GRIDCONN_NONE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- Only ESMF_GRIDCONN_NONE Grid connection implemented so far", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (connflagDim3Local(1) /= ESMF_GRIDCONN_NONE .or. &
connflagDim3Local(2) /= ESMF_GRIDCONN_NONE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- Only ESMF_GRIDCONN_NONE Grid connection implemented so far", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Setup Connections between tile sides ----------------------------------------
! CONNECTIONS DON'T WORK YET SO NOT IMPLEMENTED
! Convert coordDeps to coordDimCount and coordDimMap -------------------------------
allocate(coordDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimCount", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(coordDimMap(dimCount,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(coordDep1)) then
! error checking, if this dimension is arbitrary, one of the
! coordinate dimension has to be be ESMF_DIM_ARB
if (isDist(1)) then
found = .false.
do i=1,size(coordDep1)
if (coordDep1(i) == ESMF_DIM_ARB) found = .true.
enddo
if (.not. found) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- coordDep1 does not contain ESMF_DIM_ARB", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
coordDimCount(1)=size(coordDep1)
coordDimMap(1,:)=0
do i=1,size(coordDep1)
coordDimMap(1,i)=coordDep1(i)
enddo
else
coordDimCount(1)=1
! ESMF_DIM_ARB if 1 is distributed, otherwise 1
if (isDist(1)) then
coordDimMap(1,1)=ESMF_DIM_ARB
else
coordDimMap(1,1)=1
endif
endif
if (present(coordDep2)) then
! error checking, one of the dimensions has to be ESMF_DIM_ARB
! if dimension 2 is arbitrary
if (isDist(2)) then
found = .false.
do i=1,size(coordDep2)
if (coordDep2(i) == ESMF_DIM_ARB) found = .true.
enddo
if (.not. found) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- coordDep2 does not contain ESMF_DIM_ARB", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
coordDimCount(2)=size(coordDep2)
coordDimMap(2,:)=0
do i=1,size(coordDep2)
coordDimMap(2,i)=coordDep2(i)
enddo
else
coordDimCount(2)=1
! ESMF_DIM_ARB if 1 is distributed, otherwise 1
if (isDist(2)) then
coordDimMap(2,1)=ESMF_DIM_ARB
else
coordDimMap(2,1)=2
endif
endif
if (dimCount > 2) then
if (present(coordDep3)) then
! error checking, one of the dimensions has to be ESMF_DIM_ARB
! if dimension 3 is arbitrary
if (isDist(3)) then
found = .false.
do i=1,size(coordDep3)
if (coordDep3(i) == ESMF_DIM_ARB) found = .true.
enddo
if (.not. found) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- coordDep3 does not contain ESMF_DIM_ARB", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
coordDimCount(3)=size(coordDep3)
coordDimMap(3,:)=0
do i=1,size(coordDep3)
coordDimMap(3,i)=coordDep3(i)
enddo
else
coordDimCount(3)=1
! ESMF_DIM_ARB if 1 is distributed, otherwise 1
if (isDist(3)) then
coordDimMap(3,1)=ESMF_DIM_ARB
else
coordDimMap(3,1)=3
endif
endif
endif
! Calc undistLBound, undistUBound for Grid -----------------------------------------------
if (undistDimCount > 0) then
allocate(undistLBound(undistDimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating undistLBound", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(undistUBound(undistDimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating undistUBound", &
ESMF_CONTEXT, rcToReturn=rc)) return
! Fill in undistLBound, undistUBound
ud=1
do i=1,dimCount
if (.not. isDist(i)) then
undistLBound(ud)=indexArray(1,i)
undistUBound(ud)=indexArray(2,i)
ud=ud+1
endif
enddo
endif
! Create DistGrid --------------------------------------------------------------
if (undistDimCount > 0) then
distgrid=ESMF_DistGridCreate(local1DIndices, 1, undistLBound, undistUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
distgrid=ESMF_DistGridCreate(local1DIndices, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (present(name)) then
call ESMF_DistGridSet(distgrid, name="DG-"//trim(name), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Create Grid from specification -----------------------------------------------
ESMF_GridCreateShapeTileArb=ESMF_GridCreateFrmDistGridArb( &
distgrid, indexArray, &
distDim=distDimLocal, &
coordTypeKind=coordTypeKind, &
coordDimCount=coordDimCount, coordDimMap=coordDimMap, &
name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set internal items to be destroyed with grid
call ESMF_GridSetDestroyDistgrid(ESMF_GridCreateShapeTileArb,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout(ESMF_GridCreateShapeTileArb,destroy=.false., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(indexArray)
deallocate(local1DIndices)
deallocate(isDist)
deallocate(distDimLocal)
deallocate(coordDimCount)
deallocate(coordDimMap)
if (undistDimCount > 0) then
deallocate(undistLBound)
deallocate(undistUBound)
endif
deallocate(distSize)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreateShapeTileArb
!-------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateCubedSphereReg()"
!BOP
! !IROUTINE: ESMF_GridCreateCubedSphere - Create a multi-tile cubed sphere Grid with regular decomposition
! !INTERFACE:
! Private name; call using ESMF_GridCreateCubedSphere()
function ESMF_GridCreateCubedSphereReg(tileSize,keywordEnforcer, &
regDecompPTile, decompflagPTile, &
coordSys, coordTypeKind, &
deLabelList, staggerLocList, &
delayout, indexflag, name, transformArgs, coordCalcFlag, &
rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateCubedSphereReg
!
! !ARGUMENTS:
integer, intent(in) :: tilesize
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(in), optional :: regDecompPTile(:,:)
type(ESMF_Decomp_Flag), target, intent(in), optional :: decompflagPTile(:,:)
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: deLabelList(:)
type(ESMF_StaggerLoc), intent(in), optional :: staggerLocList(:)
type(ESMF_DELayout), intent(in), optional :: delayout
type(ESMF_Index_Flag), intent(in), optional :: indexflag
character(len=*), intent(in), optional :: name
type(ESMF_CubedSphereTransform_Args), intent(in), optional :: transformArgs
type(ESMF_CubedSphereCalc_Flag),intent(in), optional :: coordCalcFlag
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! Create a six-tile {\tt ESMF\_Grid} for a Cubed Sphere grid using regular decomposition. Each tile can
! have different decomposition. The grid coordinates are generated based on the algorithm used by GEOS-5,
! The tile resolution is defined by tileSize.
!
! The arguments are:
! \begin{description}
! \item[tilesize]
! The number of elements on each side of the tile of the Cubed Sphere grid.
! \item[{[regDecompPTile]}]
! List of DE counts for each dimension. The second index steps through
! the tiles. The total {\tt deCount} is determined as the sum over
! the products of {\tt regDecompPTile} elements for each tile.
! By default every tile is decomposed in the same way. If the total
! PET count is less than 6, one tile will be assigned to one DE and the DEs
! will be assigned to PETs sequentially, therefore, some PETs may have
! more than one DE. If the total PET count is greater than 6, the total
! number of DEs will be a multiple of 6 and less than or equal to the total
! PET count. For instance, if the total PET count is 16, the total DE count
! will be 12 with each tile decomposed into 1x2 blocks. The 12 DEs are mapped
! to the first 12 PETs and the remaining 4 PETs have no DEs locally, unless
! an optional {\tt delayout} is provided.
! \item[{[decompflagPTile]}]
! List of decomposition flags indicating how each dimension of each
! tile is to be divided between the DEs. The default setting
! is {\tt ESMF\_DECOMP\_BALANCED} in all dimensions for all tiles.
! See section \ref{const:decompflag} for a list of valid decomposition
! flag options. The second index indicates the tile number.
! \item[{[deLabelList]}]
! List assigning DE labels to the default sequence of DEs. The default
! sequence is given by the column major order of the {\tt regDecompPTile}
! elements in the sequence as they appear following the tile index.
! \item[{[staggerLocList]}]
! The list of stagger locations to fill with coordinates. Only {\tt ESMF\_STAGGERLOC\_CENTER}
! and {\tt ESMF\_STAGGERLOC\_CORNER} are supported. If not present, no coordinates
! will be added or filled.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! Only ESMF\_COORDSYS\_SPH\_DEG and ESMF\_COORDSYS\_SPH\_RAD are supported.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. Only ESMF\_TYPEKIND\_R4
! and ESMF\_TYPEKIND\_R8 are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[delayout]}]
! Optional {\tt ESMF\_DELayout} object to be used. By default a new
! DELayout object will be created with as many DEs as there are PETs,
! or tiles, which ever is greater. If a DELayout object is specified,
! the number of DEs must match {\tt regDecompPTile}, if present. In the
! case that {\tt regDecompPTile} was not specified, the {\tt deCount}
! must be at least that of the default DELayout. The
! {\tt regDecompPTile} will be constructed accordingly.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[transformArgs]}]
! A data type containing the stretch factor, target longitude, and target latitude
! to perform a Schmidt transformation on the Cubed-Sphere grid.
! \ref{sec:usage:cubedspherewttransform} for details.
! \item[{[coordCalcFlag]}]
! A flag which controls the method used to calculate the cubed sphere coordinates.
! Please see section~\ref{const:cubedspherecalcflag} for a list of options. If not set,
! defaults to {\tt ESMF\_CUBEDSPHERECALC\_1TILE} which was the original method used
! to calculate coordinates.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_VM) :: vm
integer :: PetNo, PetCnt
type(ESMF_DELayout) :: defaultDELayout
type(ESMF_Grid) :: grid, newgrid
type(ESMF_DistGrid) :: distgrid, newdistgrid
integer :: localrc
integer :: i, j
integer :: nx, ny, nxy, bigFac, totalDE
integer :: localDeCount, localDe, DeNo, tile
integer, pointer :: minIndexPTile(:,:)
integer, pointer :: maxIndexPTile(:,:)
type(ESMF_DistGridConnection), pointer :: connectionList(:)
real(kind=ESMF_KIND_R8), pointer :: lonPtrR8(:,:), latPtrR8(:,:)
real(kind=ESMF_KIND_R8), pointer :: lonCornerPtrR8(:,:), latCornerPtrR8(:,:)
real(kind=ESMF_KIND_R4), pointer :: lonPtrR4(:,:), latPtrR4(:,:)
real(kind=ESMF_KIND_R4), pointer :: lonCornerPtrR4(:,:), latCornerPtrR4(:,:)
integer :: tileCount
integer :: starti, startj, sizei, sizej
integer :: ind, rem, rem1, rem2
integer :: start(2), count(2)
integer :: shapLon(2), shapLat(2)
integer, allocatable :: regDecomp(:,:)
integer, allocatable :: demap(:)
integer :: decount
type(ESMF_Index_Flag) :: localIndexFlag
type(ESMF_CoordSys_Flag) :: coordSysLocal
type(ESMF_TypeKind_Flag) :: coordTypeKindLocal
type(ESMF_CubedSphereCalc_Flag) :: coordCalcFlagLocal
integer :: s
logical :: docenter, docorner
logical :: local_algorithm
!real(ESMF_KIND_R8) :: starttime, endtime
if (present(rc)) rc=ESMF_SUCCESS
!------------------------------------------------------------------------
! get global vm information
!
call ESMF_VMGetCurrent(vm, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! set up local pet info
call ESMF_VMGet(vm, localPet=PetNo, petCount=PetCnt, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!------------------------------------------------------------------------
! default decomposition. The number of DEs has to be multiple of 6.
! If the total PET count is less than 6, some PETs will get more than one DE.
! Otherwise, total DEs is always less than or equal to total PETs.
#if 1
if (PetCnt < 6) then
totalDE=6
else
totalDE = (PetCnt/6)*6
endif
nxy = totalDE/6
bigFac = 1
do i=2, int(sqrt(float(nxy)))
if ((nxy/i)*i == nxy) then
bigFac = i
endif
enddo
nx = bigFac
ny = nxy/nx
#else
nxy = (PetCnt + 5)/6
totalDE = 6 * nxy
nx = 1
do i = 2, int(sqrt(real(nxy)))
if (mod(nx,i) == 0) nx = i
end do
ny = nxy / nx
#endif
defaultDELayout = ESMF_DELayoutCreate(deCount = totalDE, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(indexflag)) then
localIndexFlag = indexflag
else
localIndexFlag = ESMF_INDEX_DELOCAL
endif
! Set Default coordSys
if (present(coordSys)) then
if (coordSys .eq. ESMF_COORDSYS_CART) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- only ESMF_TYPEKIND_CART is not supported", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
coordSysLocal=coordSys
else
coordSysLocal=ESMF_COORDSYS_SPH_DEG
endif
! Set Default coordTypeKind
if (present(coordTypeKind)) then
if (coordTypeKind .ne. ESMF_TYPEKIND_R4 .and. &
coordTypeKind .ne. ESMF_TYPEKIND_R8) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- only ESMF_TYPEKIND_R4 and ESMF_TYPEKIND_R8 are allowed", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
coordTypeKindLocal=coordTypeKind
else
coordTypeKindLocal=ESMF_TYPEKIND_R8
endif
! Set default coord. calc. flag
coordCalcFlagLocal=ESMF_CUBEDSPHERECALC_1TILE
if (present(coordCalcFlag)) coordCalcFlagLocal= coordCalcFlag
! set defaults
docenter = .false.
docorner = .false.
tileCount = 6
allocate(minIndexPTile(2,tileCount))
allocate(maxIndexPTile(2,tileCount))
allocate(connectionList(12))
call CalculateConnection(tilesize, minIndexPTile, maxIndexPTile, connectionList, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(regDecomp(2,6))
regDecomp(1,:)=nx
regDecomp(2,:)=ny
!-------------------------------------------
! - create DistGrid with default decomposition
! must create with ESMF_INDEX_GLOBAL because of how connections were defined
distgrid = ESMF_DistGridCreate(&
minIndexPTile=minIndexPTile, maxIndexPTile=maxIndexPTile, &
regDecompPTile=regDecomp, &
indexflag=ESMF_INDEX_GLOBAL, connectionList=connectionList, &
delayout = defaultDelayout, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(name)) then
call ESMF_DistGridSet(distgrid, name="DG-"//trim(name), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! - create Grid
grid = ESMF_GridCreate(distgrid, coordSys=coordSysLocal, &
coordTypeKind=coordTypeKindLocal, &
indexflag=localIndexFlag, name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(staggerLocList)) then
call ESMF_DELayoutGet(defaultDElayout, localDeCount = decount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (decount > 0) then
allocate(demap(0:decount-1))
call ESMF_DELayoutGet(defaultDElayout, localDeToDeMap = demap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
do s=1, size(staggerLocList)
if (staggerLocList(s) == ESMF_STAGGERLOC_EDGE1 .or. &
staggerLocList(s) == ESMF_STAGGERLOC_EDGE2) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- only ESMF_STAGGERLOC_CENTER and ESMF_STAGGERLOC_CORNER are supported", &
ESMF_CONTEXT, rcToReturn=rc)
return
elseif (staggerLocList(s) == ESMF_STAGGERLOC_CENTER) then
docenter = .TRUE.
elseif (staggerLocList(s) == ESMF_STAGGERLOC_CORNER) then
docorner = .TRUE.
endif
call ESMF_GridAddCoord(grid, staggerloc=staggerLocList(s), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
! calculate the actual cubed sphere coordiantes for each DE
do localDe = 0,decount-1
DeNo = demap(localDe)
tile = DeNo/(nx*ny)+1
rem = mod(DeNo,nx*ny)
sizei = tileSize/nx
sizej = tileSize/ny
rem1 = mod(tileSize, nx)
rem2 = mod(tileSize, ny)
ind = mod(rem,nx)
if (rem1 > 0) then
if (ind < rem1) then
sizei=sizei+1
starti=sizei*ind+1
else
starti=sizei*ind+rem1+1
endif
else
starti = sizei*ind+1
endif
ind = rem/nx
if (rem2 > 0) then
if (ind < rem2) then
sizej=sizej+1
startj=sizej*ind+1
else
startj=sizej*ind+rem2+1
endif
else
startj = sizej*ind+1
endif
!print *, DeNo, 'block:', starti, startj, sizei, sizej, tile
start(1)=starti
start(2)=startj
count(1)=sizei
count(2)=sizej
if (coordTypeKindLocal .eq. ESMF_TYPEKIND_R8) then
if (docenter) then
call ESMF_GridGetCoord(grid, coordDim=1, localDe=localDe, &
farrayPtr=lonPtrR8, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGetCoord(grid, coordDim=2, localDe=localDe, &
farrayPtr=latPtrR8, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (docorner) then
call ESMF_GridGetCoord(grid, coordDim=1, localDe=localDe, &
staggerloc=ESMF_STAGGERLOC_CORNER, farrayPtr=lonCornerPtrR8, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGetCoord(grid, coordDim=2, localDe=localDe, &
staggerloc=ESMF_STAGGERLOC_CORNER, farrayPtr=latCornerPtrR8, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
else ! ESMF_TYPEKIND_R4
if (docenter) then
call ESMF_GridGetCoord(grid, coordDim=1, localDe=localDe, &
farrayPtr=lonPtrR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGetCoord(grid, coordDim=2, localDe=localDe, &
farrayPtr=latPtrR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(lonPtrR8(count(1), count(2)), latPtrR8(count(1), count(2)))
endif
if (docorner) then
call ESMF_GridGetCoord(grid, coordDim=1, localDe=localDe, &
staggerloc=ESMF_STAGGERLOC_CORNER, farrayPtr=lonCornerPtrR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGetCoord(grid, coordDim=2, localDe=localDe, &
staggerloc=ESMF_STAGGERLOC_CORNER, farrayPtr=latCornerPtrR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
shapLon=shape(lonCornerPtrR4) ! make sure lhs and rhs is same shape
shapLat=shape(latCornerPtrR4) ! make sure lhs and rhs is same shape
allocate(lonCornerPtrR8(shapLon(1), shapLon(2)), &
latCornerPtrR8(shapLat(1),shapLat(2)))
endif
endif
!call ESMF_VMWtime(starttime, rc=localrc)
! Set coordinate calc method balop's[ed on flag (by setting local_algorithm switch)
local_algorithm=.false.
if (coordCalcFlagLocal == ESMF_CUBEDSPHERECALC_LOCAL) local_algorithm=.true.
! Generate glocal edge coordinates and local center coordinates
if (docenter .and. docorner) then
call ESMF_UtilCreateCSCoordsPar(tileSize, lonEdge=lonCornerPtrR8, &
latEdge=latCornerPtrR8, start=start, count=count, &
tile=tile, lonCenter=lonPtrR8, latCenter=latPtrR8, &
schmidtTransform=transformArgs, local_algorithm=local_algorithm)
elseif (docorner) then
call ESMF_UtilCreateCSCoordsPar(tileSize, lonEdge=lonCornerPtrR8, &
latEdge=latCornerPtrR8, start=start, count=count, tile=tile, &
schmidtTransform=transformArgs, local_algorithm=local_algorithm)
else
call ESMF_UtilCreateCSCoordsPar(tileSize, &
start=start, count=count, &
tile=tile, lonCenter=lonPtrR8, latCenter=latPtrR8, &
schmidtTransform=transformArgs, local_algorithm=local_algorithm)
endif
!call ESMF_VMWtime(endtime, rc=localrc)
if (coordTypeKindLocal .eq. ESMF_TYPEKIND_R8) then
if (docenter) then
if (coordSysLocal .eq. ESMF_COORDSYS_SPH_DEG) then
lonPtrR8 = lonPtrR8 * ESMF_COORDSYS_RAD2DEG
latPtrR8 = latPtrR8 * ESMF_COORDSYS_RAD2DEG
endif
endif
if (docorner) then
if (coordSysLocal .eq. ESMF_COORDSYS_SPH_DEG) then
lonCornerPtrR8 = lonCornerPtrR8 * ESMF_COORDSYS_RAD2DEG
latCornerPtrR8 = latCornerPtrR8 * ESMF_COORDSYS_RAD2DEG
endif
endif
else ! ESMF_TYPE_KIND_R4
if (docenter) then
if (coordSysLocal .eq. ESMF_COORDSYS_SPH_DEG) then
lonPtrR4 = lonPtrR8 * ESMF_COORDSYS_RAD2DEG
latPtrR4 = latPtrR8 * ESMF_COORDSYS_RAD2DEG
else
lonPtrR4 = lonPtrR8
latPtrR4 = latPtrR8
endif
deallocate(lonPtrR8, latPtrR8)
endif
if (docorner) then
if (coordSysLocal .eq. ESMF_COORDSYS_SPH_DEG) then
lonCornerPtrR4 = lonCornerPtrR8 * ESMF_COORDSYS_RAD2DEG
latCornerPtrR4 = latCornerPtrR8 * ESMF_COORDSYS_RAD2DEG
else
lonCornerPtrR4 = lonCornerPtrR8
latCornerPtrR4 = latCornerPtrR8
endif
deallocate(lonCornerPtrR8, latCornerPtrR8)
endif
endif
!print *, 'Create CS size ', tileSize, 'in', (endtime-starttime)*1000.0, ' msecs'
end do
endif
! Create another distgrid with user specified decomposition
if (present(decompflagPTile) .or. present(regDecompPTile) .or. &
present(delabelList) .or. present(delayout)) then
newdistgrid = ESMF_DistGridCreate(&
minIndexPTile=minIndexPTile, maxIndexPTile=maxIndexPTile, &
regDecompPTile=regDecompPTile, &
decompflagPTile=decompflagPTile, &
delabelList = delabelList, &
indexflag=ESMF_INDEX_GLOBAL, connectionList=connectionList, &
delayout = delayout, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!Redist the grid with the new distgrid
newgrid = ESMF_GridCreate(grid, newdistgrid, name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Destroy old grid
call ESMF_GridDestroy(grid, noGarbage=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Destroy old distgrid
call ESMF_DistGridDestroy(distgrid, noGarbage=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
ESMF_GridCreateCubedSphereReg = newgrid
else
ESMF_GridCreateCubedSphereReg = grid
endif
! - deallocate connectionList
deallocate(minIndexPTile, maxIndexPTile)
deallocate(connectionList)
return
end function ESMF_GridCreateCubedSphereReg
!-------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateCubedSphereIReg()"
!BOP
! !IROUTINE: ESMF_GridCreateCubedSphere - Create a multi-tile cubed sphere Grid with irregular decomposition
! !INTERFACE:
! Private name; call using ESMF_GridCreateCubedSphere()
function ESMF_GridCreateCubedSphereIReg(tileSize, &
countsPerDEDim1PTile, countsPerDEDim2PTile, &
keywordEnforcer, &
coordSys, coordTypeKind, &
deLabelList, staggerLocList, &
delayout, indexflag, name, transformArgs, coordCalcFlag, &
rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateCubedSphereIReg
!
! !ARGUMENTS:
integer, intent(in) :: tilesize
integer, intent(in) :: countsPerDEDim1PTile(:,:)
integer, intent(in) :: countsPerDEDim2PTile(:,:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: deLabelList(:)
type(ESMF_StaggerLoc), intent(in), optional :: staggerLocList(:)
type(ESMF_DELayout), intent(in), optional :: delayout
type(ESMF_Index_Flag), intent(in), optional :: indexflag
character(len=*), intent(in), optional :: name
type(ESMF_CubedSphereTransform_Args), intent(in), optional :: transformArgs
type(ESMF_CubedSphereCalc_Flag),intent(in), optional :: coordCalcFlag
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! Create a six-tile {\tt ESMF\_Grid} for a Cubed Sphere grid using irregular decomposition. Each tile can
! have different decomposition. The grid coordinates are generated based on the algorithm used by GEOS-5,
! The tile resolution is defined by tileSize.
!
! The arguments are:
! \begin{description}
! \item[tilesize]
! The number of elements on each side of the tile of the Cubed Sphere grid.
! \item[countsPerDEDim1PTile]
! This array specifies the number of cells per DE for index dimension 1 for the
! center stagger location. The second index steps through the tiles. If each tile is
! decomposed into different number of DEs, the first dimension is the maximal DEs of
! all the tiles.
! \item[countsPerDEDim2PTile]
! This array specifies the number of cells per DE for index dimension 2 for the
! center stagger location. The second index steps through the tiles. If each tile is
! decomposed into different number of DEs, the first dimension is the maximal DEs of
! all the tiles.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! Only ESMF\_COORDSYS\_SPH\_DEG and ESMF\_COORDSYS\_SPH\_RAD are supported.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. Only ESMF\_TYPEKIND\_R4
! and ESMF\_TYPEKIND\_R8 are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[deLabelList]}]
! List assigning DE labels to the default sequence of DEs. The default
! sequence is given by the column major order in the sequence as they appear
! in {\tt countsPerDEDim1PTile}, followed by {\tt countsPerDEDim2PTile}, then the
! tile index.
! \item[{[staggerLocList]}]
! The list of stagger locations to fill with coordinates. Only {\tt ESMF\_STAGGERLOC\_CENTER}
! and {\tt ESMF\_STAGGERLOC\_CORNER} are supported. If not present, no coordinates
! will be added or filled.
! \item[{[delayout]}]
! Optional ESMF\_DELayout object to be used. If a delayout object is specified,
! the number of DEs must match with the total DEs defined in {\tt countsPerDEDim1PTile}
! and {\tt countsPerDEDim2PTile}.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[transformArgs]}]
! A data type containing the stretch factor, target longitude, and target latitude
! to perform a Schmidt transformation on the Cubed-Sphere grid. See section
! \ref{sec:usage:cubedspherewttransform} for details.
! \item[{[coordCalcFlag]}]
! A flag which controls the method used to calculate the cubed sphere coordinates.
! Please see section~\ref{const:cubedspherecalcflag} for a list of options. If not set,
! defaults to {\tt ESMF\_CUBEDSPHERECALC\_1TILE} which was the original method used
! to calculate coordinates.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_VM) :: vm
integer :: PetNo, PetCnt
type(ESMF_DELayout) :: defaultDELayout
type(ESMF_Grid) :: grid, newgrid
type(ESMF_DistGrid) :: distgrid, newdistgrid
integer :: localrc
integer :: i, j
integer :: nx, ny, nxy, bigFac, totalDE
integer :: localDeCount, localDe, DeNo, tile
integer, pointer :: minIndexPTile(:,:)
integer, pointer :: maxIndexPTile(:,:)
type(ESMF_DistGridConnection), pointer :: connectionList(:)
real(kind=ESMF_KIND_R8), pointer :: lonPtrR8(:,:), latPtrR8(:,:)
real(kind=ESMF_KIND_R8), pointer :: lonCornerPtrR8(:,:), latCornerPtrR8(:,:)
real(kind=ESMF_KIND_R4), pointer :: lonPtrR4(:,:), latPtrR4(:,:)
real(kind=ESMF_KIND_R4), pointer :: lonCornerPtrR4(:,:), latCornerPtrR4(:,:)
integer :: tileCount
integer :: start(2), count(2)
integer :: shapLon(2), shapLat(2)
integer :: decount
type(ESMF_Index_Flag) :: localIndexFlag
type(ESMF_CoordSys_Flag) :: coordSysLocal
type(ESMF_TypeKind_Flag) :: coordTypeKindLocal
type(ESMF_CubedSphereCalc_Flag) :: coordCalcFlagLocal
integer :: s
logical :: docenter, docorner
integer, pointer :: deBlockList(:,:,:), deToTileMap(:)
integer, pointer :: DeDim1(:), DeDim2(:), demap(:)
integer :: k,t, minIndx, minIndy
integer :: myde, startde, endde
integer :: tiles, totalelmt
logical :: local_algorithm
!real(ESMF_KIND_R8) :: starttime, endtime
if (present(rc)) rc=ESMF_SUCCESS
!------------------------------------------------------------------------
! get global vm information
!
call ESMF_VMGetCurrent(vm, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! set up local pet info
call ESMF_VMGet(vm, localPet=PetNo, petCount=PetCnt, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! calculate totalDE based on the decomposition
tiles=size(countsPerDEDim1PTile,2)
if (tiles /= 6) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- the second dimension of countsPerDEDim1PTile is not equal to 6", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (size(countsPerDEDim2PTile,2) /= 6) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- the second dimension of countsPerDEDim2PTile is not equal to 6", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
allocate(DeDim1(tiles), DeDim2(tiles))
do j=1,tiles
totalelmt = 0
DeDim1(j)=size(countsPerDEDim1Ptile,1)
DeDim2(j)=size(countsPerDEDim2Ptile,1)
do i=1,size(countsPerDEDim1PTile,1)
! check the total elements counts in dimension 1 is equal to tilesize
! count how many DEs for this tile
totalelmt = countsPerDEDim1PTile(i,j)+totalelmt
if (countsPerDEDim1PTile(i,j)==0) then
DeDim1(j)=i-1
exit
endif
enddo
if (totalelmt /= tilesize) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- the total number of elements in dimension 1 does not add up to tilesize", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
totalelmt = 0
do i=1,size(countsPerDEDim2PTile,1)
! check the total elements counts in dimension 1 is equal to tilesize
! count how many DEs for this tile
totalelmt = countsPerDEDim2PTile(i,j)+totalelmt
if (countsPerDEDim2PTile(i,j)==0) then
DeDim2(j)=i-1
exit
endif
enddo
if (totalelmt /= tilesize) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- the total number of elements in dimension 2 does not add up to tilesize", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
enddo
!if (PetNo == 0) then
! print *, 'DeDim: ', DeDim1(:), DeDim2(:)
!endif
! calculate totalDE
totalDE=0
do j=1,tiles
totalDE = totalDE+DeDim1(j)*DeDim2(j)
enddo
if (present(delayout)) then
!Check if delayout has the same number of DEs
call ESMF_DELayoutGet(delayout, deCount=deCount, rc=localrc)
if (deCount /= totalDE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- the total number of DEs specified in delayout is inconsistent with the decomposition arguments", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
defaultDELayout = delayout
else
defaultDELayout = ESMF_DELayoutCreate(deCount = totalDE, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (present(indexflag)) then
localIndexFlag = indexflag
else
localIndexFlag = ESMF_INDEX_DELOCAL
endif
! Set Default coordSys
if (present(coordSys)) then
if (coordSys .eq. ESMF_COORDSYS_CART) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- only ESMF_TYPEKIND_CART is not supported", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
coordSysLocal=coordSys
else
coordSysLocal=ESMF_COORDSYS_SPH_DEG
endif
! Set Default coordTypeKind
if (present(coordTypeKind)) then
if (coordTypeKind .ne. ESMF_TYPEKIND_R4 .and. &
coordTypeKind .ne. ESMF_TYPEKIND_R8) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- only ESMF_TYPEKIND_R4 and ESMF_TYPEKIND_R8 are allowed", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
coordTypeKindLocal=coordTypeKind
else
coordTypeKindLocal=ESMF_TYPEKIND_R8
endif
! Set default coord. calc. flag
coordCalcFlagLocal=ESMF_CUBEDSPHERECALC_1TILE
if (present(coordCalcFlag)) coordCalcFlagLocal= coordCalcFlag
! set defaults
docenter = .false.
docorner = .false.
tileCount = 6
allocate(minIndexPTile(2,tileCount))
allocate(maxIndexPTile(2,tileCount))
allocate(connectionList(12))
call CalculateConnection(tilesize, minIndexPTile, maxIndexPTile, connectionList, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_DELayoutGet(defaultDelayout, DeCount = decount, localDeCount=localDeCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(demap(localdecount))
call ESMF_DELayoutGet(defaultDelayout, localDeToDeMap = demap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! deBlockList and deToTileMap contains all the blocks for all the DEs (not
! just the localDEs
allocate(deBlockList(2,2,decount),deToTileMap(decount))
!print *, PetNo, 'total DE count ', decount
! minIndexPTile and maxIndexPTile are in ESMF_INDEX_GLOBAL, therefore, need
! to use global index in deBlockList as well
k=1
do t=1,tiles
do j=1,DeDim2(t)
do i=1,DeDim1(t)
minIndx = sum(countsPerDEDim1PTile(1:i-1,t))+minIndexPTile(1,t)
minIndy = sum(countsPerDEDim2PTile(1:j-1,t))+minIndexPTile(2,t)
deBlockList(1,1,k)=minIndx
deBlockList(2,1,k)=minIndy
deBlockList(1,2,k)=minIndx+countsPerDEDim1PTile(i,t)-1
deBlockList(2,2,k)=minIndy+countsPerDEDim2PTile(j,t)-1
deToTileMap(k)=t
k=k+1
enddo
enddo
enddo
! need to constrcut deBlockList and deToTileMap
distgrid = ESMF_DistGridCreate(&
minIndexPTile=minIndexPTile, maxIndexPTile=maxIndexPTile, &
deBlockList = deBlockList, deToTileMap = deToTileMap, &
indexflag=ESMF_INDEX_GLOBAL, connectionList=connectionList, &
deLabelList = deLabelList, &
delayout = defaultDelayout, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! - create Grid
grid = ESMF_GridCreate(distgrid, coordSys=coordSysLocal, &
coordTypeKind=coordTypeKindLocal, &
indexflag=localIndexFlag, name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(staggerLocList)) then
do s=1, size(staggerLocList)
if (staggerLocList(s) == ESMF_STAGGERLOC_EDGE1 .or. &
staggerLocList(s) == ESMF_STAGGERLOC_EDGE2) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- only ESMF_STAGGERLOC_CENTER and ESMF_STAGGERLOC_CORNER are supported", &
ESMF_CONTEXT, rcToReturn=rc)
return
elseif (staggerLocList(s) == ESMF_STAGGERLOC_CENTER) then
docenter = .TRUE.
elseif (staggerLocList(s) == ESMF_STAGGERLOC_CORNER) then
docorner = .TRUE.
endif
call ESMF_GridAddCoord(grid, staggerloc=staggerLocList(s), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
! calculate the actual cubed sphere coordiantes for each DE
do i = 1,localdecount
j = demap(i)+1
localDe = i-1
start(1)=deBlockList(1,1,j)-minIndexPTile(1,deToTileMap(j))+1
start(2)=deBlockList(2,1,j)-minIndexPTile(2,deToTileMap(j))+1
count(1)=deBlockList(1,2,j)-deBlockList(1,1,j)+1
count(2)=deBlockList(2,2,j)-deBlockList(2,1,j)+1
tile = deToTileMap(j)
if (coordTypeKindLocal .eq. ESMF_TYPEKIND_R8) then
if (docenter) then
call ESMF_GridGetCoord(grid, coordDim=1, localDe=localDe, &
farrayPtr=lonPtrR8, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGetCoord(grid, coordDim=2, localDe=localDe, &
farrayPtr=latPtrR8, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (docorner) then
call ESMF_GridGetCoord(grid, coordDim=1, localDe=localDe, &
staggerloc=ESMF_STAGGERLOC_CORNER, farrayPtr=lonCornerPtrR8, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGetCoord(grid, coordDim=2, localDe=localDe, &
staggerloc=ESMF_STAGGERLOC_CORNER, farrayPtr=latCornerPtrR8, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
else ! ESMF_TYPEKIND_R4
if (docenter) then
call ESMF_GridGetCoord(grid, coordDim=1, localDe=localDe, &
farrayPtr=lonPtrR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGetCoord(grid, coordDim=2, localDe=localDe, &
farrayPtr=latPtrR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(lonPtrR8(count(1), count(2)), latPtrR8(count(1), count(2)))
endif
if (docorner) then
call ESMF_GridGetCoord(grid, coordDim=1, localDe=localDe, &
staggerloc=ESMF_STAGGERLOC_CORNER, farrayPtr=lonCornerPtrR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGetCoord(grid, coordDim=2, localDe=localDe, &
staggerloc=ESMF_STAGGERLOC_CORNER, farrayPtr=latCornerPtrR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
shapLon=shape(lonCornerPtrR4) ! make sure lhs and rhs is same shape
shapLat=shape(latCornerPtrR4) ! make sure lhs and rhs is same shape
allocate(lonCornerPtrR8(shapLon(1), shapLon(2)), &
latCornerPtrR8(shapLat(1),shapLat(2)))
endif
endif
!call ESMF_VMWtime(starttime, rc=localrc)
! Set coordinate calc method balop's[ed on flag (by setting local_algorithm switch)
local_algorithm=.false.
if (coordCalcFlagLocal == ESMF_CUBEDSPHERECALC_LOCAL) local_algorithm=.true.
! Generate glocal edge coordinates and local center coordinates
if (docenter .and. docorner) then
call ESMF_UtilCreateCSCoordsPar(tileSize, lonEdge=lonCornerPtrR8, &
latEdge=latCornerPtrR8, start=start, count=count, &
tile=tile, lonCenter=lonPtrR8, latCenter=latPtrR8, &
schmidtTransform=transformArgs, local_algorithm=local_algorithm)
elseif (docorner) then
call ESMF_UtilCreateCSCoordsPar(tileSize, lonEdge=lonCornerPtrR8, &
latEdge=latCornerPtrR8, start=start, count=count, tile=tile, &
schmidtTransform=transformArgs, local_algorithm=local_algorithm)
else
call ESMF_UtilCreateCSCoordsPar(tileSize, &
start=start, count=count, &
tile=tile, lonCenter=lonPtrR8, latCenter=latPtrR8, &
schmidtTransform=transformArgs, local_algorithm=local_algorithm)
endif
!call ESMF_VMWtime(endtime, rc=localrc)
if (coordTypeKindLocal .eq. ESMF_TYPEKIND_R8) then
if (docenter) then
if (coordSysLocal .eq. ESMF_COORDSYS_SPH_DEG) then
lonPtrR8 = lonPtrR8 * ESMF_COORDSYS_RAD2DEG
latPtrR8 = latPtrR8 * ESMF_COORDSYS_RAD2DEG
endif
endif
if (docorner) then
if (coordSysLocal .eq. ESMF_COORDSYS_SPH_DEG) then
lonCornerPtrR8 = lonCornerPtrR8 * ESMF_COORDSYS_RAD2DEG
latCornerPtrR8 = latCornerPtrR8 * ESMF_COORDSYS_RAD2DEG
endif
endif
else ! ESMF_TYPE_KIND_R4
if (docenter) then
if (coordSysLocal .eq. ESMF_COORDSYS_SPH_DEG) then
lonPtrR4 = lonPtrR8 * ESMF_COORDSYS_RAD2DEG
latPtrR4 = latPtrR8 * ESMF_COORDSYS_RAD2DEG
else
lonPtrR4 = lonPtrR8
latPtrR4 = latPtrR8
endif
deallocate(lonPtrR8, latPtrR8)
endif
if (docorner) then
if (coordSysLocal .eq. ESMF_COORDSYS_SPH_DEG) then
lonCornerPtrR4 = lonCornerPtrR8 * ESMF_COORDSYS_RAD2DEG
latCornerPtrR4 = latCornerPtrR8 * ESMF_COORDSYS_RAD2DEG
else
lonCornerPtrR4 = lonCornerPtrR8
latCornerPtrR4 = latCornerPtrR8
endif
deallocate(lonCornerPtrR8, latCornerPtrR8)
endif
endif
!print *, 'Create CS size ', tileSize, 'in', (endtime-starttime)*1000.0, ' msecs'
end do
endif
ESMF_GridCreateCubedSphereIReg = grid
! - deallocate connectionList
deallocate(minIndexPTile, maxIndexPTile)
deallocate(connectionList)
deallocate(deBlockList,deToTileMap)
deallocate(DeDim1, DeDim2, demap)
return
end function ESMF_GridCreateCubedSphereIReg
!-------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "CalculateConnection()"
!IBOP
! !IROUTINE: CalculateConnection - internal subroutine called by ESMF_GridCreateCubedSphere
subroutine CalculateConnection(centerCount, minIndexPTile, &
maxIndexPTile, connectionList, rc)
! !ARGUMENTS:
integer, intent(in) :: centerCount
integer, pointer :: minIndexPTile(:,:)
integer, pointer :: maxIndexPTile(:,:)
type(ESMF_DistGridConnection), pointer :: connectionList(:)
integer, intent(out) :: rc
!IEOP
integer :: i, j, conn
integer :: tileCount, tile
integer :: connectionCount
integer :: localrc
rc=ESMF_SUCCESS
tileCount = 6
! - initialize Min/Max
! The full cubed sphere has 6 tiles. For testing, tiles can be
! turned on incrementally from 1 all the way to 6. Anything greater than
! 6 is incorrect.
tile=0
if (tile==tileCount) goto 10
!- tile 1
tile=1
minIndexPTile(1,tile)=1
minIndexPTile(2,tile)=1
maxIndexPTile(1,tile)=minIndexPTile(1,tile)+centerCount-1
maxIndexPTile(2,tile)=minIndexPTile(2,tile)+centerCount-1
if (tile==tileCount) goto 10
!- tile 2
tile=2
minIndexPTile(1,tile)=maxIndexPTile(1,tile-1)+1
minIndexPTile(2,tile)=minIndexPTile(2,tile-1)
maxIndexPTile(1,tile)=minIndexPTile(1,tile)+centerCount-1
maxIndexPTile(2,tile)=minIndexPTile(2,tile)+centerCount-1
if (tile==tileCount) goto 10
!- tile 3
tile=3
minIndexPTile(1,tile)=minIndexPTile(1,tile-1)
minIndexPTile(2,tile)=maxIndexPTile(2,tile-1)+1
maxIndexPTile(1,tile)=minIndexPTile(1,tile)+centerCount-1
maxIndexPTile(2,tile)=minIndexPTile(2,tile)+centerCount-1
if (tile==tileCount) goto 10
!- tile 4
tile=4
minIndexPTile(1,tile)=maxIndexPTile(1,tile-1)+1
minIndexPTile(2,tile)=minIndexPTile(2,tile-1)
maxIndexPTile(1,tile)=minIndexPTile(1,tile)+centerCount-1
maxIndexPTile(2,tile)=minIndexPTile(2,tile)+centerCount-1
if (tile==tileCount) goto 10
!- tile 5
tile=5
minIndexPTile(1,tile)=minIndexPTile(1,tile-1)
minIndexPTile(2,tile)=maxIndexPTile(2,tile-1)+1
maxIndexPTile(1,tile)=minIndexPTile(1,tile)+centerCount-1
maxIndexPTile(2,tile)=minIndexPTile(2,tile)+centerCount-1
if (tile==tileCount) goto 10
!- tile 6
tile=6
minIndexPTile(1,tile)=maxIndexPTile(1,tile-1)+1
minIndexPTile(2,tile)=minIndexPTile(2,tile-1)
maxIndexPTile(1,tile)=minIndexPTile(1,tile)+centerCount-1
maxIndexPTile(2,tile)=minIndexPTile(2,tile)+centerCount-1
if (tile==tileCount) goto 10
10 continue
! - connectionList
! The full cubed sphere has 12 conections. For testing, connections can be
! turned on incrementally from 0 all the way to 12. Anything greater than
! 12 is incorrect.
connectionCount = 12 ! between 0 ... and ... 12.
! Connections are either defined on the basis of centers or corners, they
! are NOT the same! Our current strategy is to define connections for
! centers, and add corners with padding and no connections. This way we
! can regrid center data bilinear and conservatively. We cannot handle
! regridding for data on corner stagger, plus we have degeneracies in that
! case of exlusive elements. However, we believe that the current
! application of this is for only data on center stagger.
conn=0
if (conn==connectionCount) goto 20
conn=conn+1
call ESMF_DistGridConnectionSet(connection=connectionList(conn), &
tileIndexA=1, tileIndexB=2, positionVector=(/0, 0/), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (conn==connectionCount) goto 20
conn=conn+1
call ESMF_DistGridConnectionSet(connection=connectionList(conn), &
tileIndexA=2, tileIndexB=3, positionVector=(/0, 0/), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (conn==connectionCount) goto 20
conn=conn+1
call ESMF_DistGridConnectionSet(connection=connectionList(conn), &
tileIndexA=3, tileIndexB=4, positionVector=(/0, 0/), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (conn==connectionCount) goto 20
conn=conn+1
call ESMF_DistGridConnectionSet(connection=connectionList(conn), &
tileIndexA=4, tileIndexB=5, positionVector=(/0, 0/), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (conn==connectionCount) goto 20
conn=conn+1
call ESMF_DistGridConnectionSet(connection=connectionList(conn), &
tileIndexA=5, tileIndexB=6, positionVector=(/0, 0/), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (conn==connectionCount) goto 20
conn=conn+1
call ESMF_DistGridConnectionSet(connection=connectionList(conn), &
tileIndexA=1, tileIndexB=6, &
positionVector=(/ & ! only shift
minIndexPTile(1,6)-minIndexPTile(1,1), &
maxIndexPTile(2,6)-minIndexPTile(2,1)+1/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (conn==connectionCount) goto 20
conn=conn+1
call ESMF_DistGridConnectionSet(connection=connectionList(conn), &
tileIndexA=1, tileIndexB=3, orientationVector=(/2, -1/), & ! 270 deg rot
positionVector=(/minIndexPTile(1,3)-1-maxIndexPTile(2,1), &
maxIndexPTile(2,3)+minIndexPTile(1,1)/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (conn==connectionCount) goto 20
conn=conn+1
call ESMF_DistGridConnectionSet(connection=connectionList(conn), &
tileIndexA=2, tileIndexB=4, orientationVector=(/-2, 1/), & ! 90 deg rot
positionVector=(/minIndexPTile(1,4)+maxIndexPTile(2,2), &
minIndexPTile(2,4)-maxIndexPTile(1,2)-1/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (conn==connectionCount) goto 20
conn=conn+1
call ESMF_DistGridConnectionSet(connection=connectionList(conn), &
tileIndexA=3, tileIndexB=5, orientationVector=(/2, -1/), & ! 270 deg rot
positionVector=(/minIndexPTile(1,5)-1-maxIndexPTile(2,3), &
maxIndexPTile(2,5)+minIndexPTile(1,3)/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (conn==connectionCount) goto 20
conn=conn+1
call ESMF_DistGridConnectionSet(connection=connectionList(conn), &
tileIndexA=4, tileIndexB=6, orientationVector=(/-2, 1/), & ! 90 deg rot
positionVector=(/minIndexPTile(1,6)+maxIndexPTile(2,4), &
minIndexPTile(2,6)-maxIndexPTile(1,4)-1/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (conn==connectionCount) goto 20
conn=conn+1
call ESMF_DistGridConnectionSet(connection=connectionList(conn), &
tileIndexA=5, tileIndexB=1, orientationVector=(/2, -1/), & ! 270 deg rot
positionVector=(/minIndexPTile(1,1)-1-maxIndexPTile(2,5), &
maxIndexPTile(2,1)+minIndexPTile(1,5)/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (conn==connectionCount) goto 20
conn=conn+1
call ESMF_DistGridConnectionSet(connection=connectionList(conn), &
tileIndexA=6, tileIndexB=2, orientationVector=(/-2, 1/), & ! 90 deg rot
positionVector=(/minIndexPTile(1,2)+maxIndexPTile(2,6), &
minIndexPTile(2,2)-maxIndexPTile(1,6)-1/), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (conn==connectionCount) goto 20
20 continue
return
end subroutine CalculateConnection
!-------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateMosaicReg()"
!BOP
!\label{API:GridCreateMosaicReg}
! !IROUTINE: ESMF_GridCreateMosaic - Create a multi-tile Grid object with regular decomposition using the grid definition from a GRIDSPEC Mosaic file.
! !INTERFACE:
function ESMF_GridCreateMosaicReg(filename,keywordEnforcer, regDecompPTile, decompflagPTile, &
coordTypeKind, deLabelList, staggerLocList, delayout, indexflag, name, tileFilePath, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateMosaicReg
!
! !ARGUMENTS:
character(len=*), intent(in) :: filename
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(in), optional :: regDecompPTile(:,:)
type(ESMF_Decomp_Flag), target, intent(in), optional :: decompflagPTile(:,:)
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: deLabelList(:)
type(ESMF_StaggerLoc), intent(in), optional :: staggerLocList(:)
type(ESMF_DELayout), intent(in), optional :: delayout
type(ESMF_Index_Flag), intent(in), optional :: indexflag
character(len=*), intent(in), optional :: name
character(len=*), intent(in), optional :: tileFilePath
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! Create a multiple-tile {\tt ESMF\_Grid} based on the definition from a GRIDSPEC Mosaic file and its associated
! tile files using regular decomposition. Each tile can have different decomposition. The tile connections
! are defined in a GRIDSPEC format Mosaic file.
! And each tile's coordination is defined in a separate NetCDF file. The coordinates defined
! in the tile file is so-called "Super Grid". In other words, the dimensions of the coordinate variables are
! {\tt (2*xdim+1, 2*ydim+1)} if {\tt (xdim, ydim)} is the size of the tile. The Super Grid combines the corner,
! the edge and the center coordinates in one big array. A Mosaic file may contain just one tile. If a Mosaic contains
! multiple tiles. Each tile is a logically rectangular lat/lon grid. Currently, all the tiles have to be the same size.
! We will remove this limitation in the future release.
!
!
! The arguments are:
! \begin{description}
! \item[filename]
! The name of the GRIDSPEC Mosaic file.
! \item[{[regDecompPTile]}]
! List of DE counts for each dimension. The second index steps through
! the tiles. The total {\tt deCount} is determined as the sum over
! the products of {\tt regDecompPTile} elements for each tile.
! By default every tile is decomposed in the same way. If the total
! PET count is less than the tile count, one tile will be assigned to one DE and the DEs
! will be assigned to PETs sequentially, therefore, some PETs may have
! more than one DE. If the total PET count is greater than the tile count, the total
! number of DEs will be a multiple of the tile count and less than or equal to the total
! PET count. For instance, if the total PET count is 16 and the tile count is 6, the total DE count
! will be 12 with each tile decomposed into 1x2 blocks. The 12 DEs are mapped
! to the first 12 PETs and the remaining 4 PETs have no DEs locally, unless
! an optional {\tt delayout} is provided.
! \item[{[decompflagPTile]}]
! List of decomposition flags indicating how each dimension of each
! tile is to be divided between the DEs. The default setting
! is {\tt ESMF\_DECOMP\_BALANCED} in all dimensions for all tiles.
! See section \ref{const:decompflag} for a list of valid decomposition
! flag options. The second index indicates the tile number.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. Only ESMF\_TYPEKIND\_R4
! and ESMF\_TYPEKIND\_R8 are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[deLabelList]}]
! List assigning DE labels to the default sequence of DEs. The default
! sequence is given by the column major order of the {\tt regDecompPTile}
! elements in the sequence as they appear following the tile index.
! \item[{[staggerLocList]}]
! The list of stagger locations to fill with coordinates. Please see Section~\ref{const:staggerloc}
! for a description of the available stagger locations. If not present, no coordinates
! will be added or filled.
! \item[{[delayout]}]
! Optional {\tt ESMF\_DELayout} object to be used. By default a new
! DELayout object will be created with as many DEs as there are PETs,
! or tiles, which ever is greater. If a DELayout object is specified,
! the number of DEs must match {\tt regDecompPTile}, if present. In the
! case that {\tt regDecompPTile} was not specified, the {\tt deCount}
! must be at least that of the default DELayout. The
! {\tt regDecompPTile} will be constructed accordingly.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[tileFilePath]}]
! Optional argument to define the path where the tile files reside. If it
! is given, it overwrites the path defined in {\tt gridlocation} variable
! in the mosaic file.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_VM) :: vm
integer :: PetNo, PetCnt
integer :: totalDE, nxy, nx, ny, bigFac
integer :: sizex, sizey
type(ESMF_DELayout) :: defaultDELayout
type(ESMF_Grid) :: grid, newgrid
type(ESMF_DistGrid) :: distgrid, newdistgrid
integer :: localrc
type(ESMF_DistGridConnection), allocatable :: connectionList(:)
integer :: i, j, k, conn
integer :: localDeCount, localDe, DeNo, tile
real(kind=ESMF_KIND_R8), pointer :: lonPtrR8(:,:), latPtrR8(:,:)
real(kind=ESMF_KIND_R8), pointer :: lonCornerPtrR8(:,:), latCornerPtrR8(:,:)
real(kind=ESMF_KIND_R4), pointer :: lonPtrR4(:,:), latPtrR4(:,:)
real(kind=ESMF_KIND_R4), pointer :: lonCornerPtrR4(:,:), latCornerPtrR4(:,:)
integer :: tileCount
integer :: connectionCount
integer :: tileSize
integer :: starti, startj, sizei, sizej
integer :: ind, rem, rem1, rem2
integer :: start(2), count(2)
integer, pointer :: minIndexPTile(:,:)
integer, pointer :: maxIndexPTile(:,:)
integer, pointer :: minIndexPDe(:,:)
integer, pointer :: maxIndexPDe(:,:)
integer, allocatable :: regDecomp2(:,:)
integer, allocatable :: demap(:)
integer :: decount
!real(ESMF_KIND_R8) :: starttime, endtime
character(len=ESMF_MAXPATHLEN) :: tempname
type(ESMF_Mosaic) :: mosaic
integer :: totallen
integer :: posVec(2), orientVec(2)
integer :: regDecomp(2)
type(ESMF_Decomp_Flag) :: decompflag(2)
type(ESMF_Index_Flag) :: localIndexFlag
logical :: isGlobal
integer, pointer :: PetMap1D(:), PetMap(:,:,:)
integer :: lbnd(2), ubnd(2)
integer :: s
type(ESMF_TypeKind_Flag) :: coordTypeKindLocal
if (present(rc)) rc=ESMF_SUCCESS
if (present(indexflag)) then
localIndexFlag = indexflag
else
localIndexFlag = ESMF_INDEX_DELOCAL
endif
! Set Default coordTypeKind
if (present(coordTypeKind)) then
if (coordTypeKind .ne. ESMF_TYPEKIND_R4 .and. &
coordTypeKind .ne. ESMF_TYPEKIND_R8) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- only ESMF_TYPEKIND_R4 and ESMF_TYPEKIND_R8 are allowed", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
coordTypeKindLocal=coordTypeKind
else
coordTypeKindLocal=ESMF_TYPEKIND_R8
endif
!------------------------------------------------------------------------
!------------------------------------------------------------------------
! get global vm information
!
call ESMF_VMGetCurrent(vm, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! set up local pet info
call ESMF_VMGet(vm, localPet=PetNo, petCount=PetCnt, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSpecReadMosaic(filename, mosaic, tileFilePath=tileFilePath, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
tileCount = mosaic%ntiles
sizex = mosaic%nx
sizey = mosaic%ny
if (tileCount > 1) then
! use local index for everytile
! should support different tile sizes -- TBD
allocate(minIndexPTile(2,tileCount))
allocate(maxIndexPTile(2,tileCount))
minIndexPTile(1,:)=1
minIndexPTile(2,:)=1
maxIndexPTile(1,:)=sizex
maxIndexPTile(2,:)=sizey
! build connectionList for each connecation
connectionCount = mosaic%ncontacts
allocate(connectionList(connectionCount))
do i=1,connectionCount
call calculateConnect(minIndexPTile, maxIndexPTile, mosaic%contact(:,i), &
mosaic%connindex(:,:,i), orientVec, posVec)
call ESMF_DistGridConnectionSet(connection=connectionList(i), &
tileIndexA=mosaic%contact(1,i), tileIndexB=mosaic%contact(2,i), &
positionVector=(/posVec(1), posVec(2)/), &
orientationVector = (/orientVec(1), orientVec(2)/), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
!------------------------------------------------------------------------
! default decomposition. The number of DEs has to be multiple of the tile count.
! If the total PET count is less than the tile count, some PETs will get more than one DE.
! Otherwise, total DEs is always less than or equal to total PETs.
if (PetCnt < tileCount) then
totalDE=tileCount
else
totalDE = (PetCnt/tileCount)*tileCount
endif
nxy = totalDE/tileCount
bigFac = 1
do i=2, int(sqrt(float(nxy)))
if ((nxy/i)*i == nxy) then
bigFac = i
endif
enddo
nx = bigFac
ny = nxy/nx
defaultDELayout = ESMF_DELayoutCreate(deCount = totalDE, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_DELayoutGet(defaultDElayout, localDeCount = decount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (decount > 0) then
allocate(demap(0:decount-1))
call ESMF_DELayoutGet(defaultDElayout, localDeToDeMap = demap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!print *, PetNo, ' demap ', decount, demap
endif
allocate(regDecomp2(2,tileCount))
regDecomp2(1,:)=nx
regDecomp2(2,:)=ny
!-------------------------------------------
! - create DistGrid with default decomposition
! must create with ESMF_INDEX_DELOCAL because of how connections were defined
distgrid = ESMF_DistGridCreate(&
minIndexPTile=minIndexPTile, maxIndexPTile=maxIndexPTile, &
regDecompPTile=regDecomp2, &
indexflag=ESMF_INDEX_DELOCAL, connectionList=connectionList, &
delayout = defaultDelayout, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! - create Grid
! coordinates from the cubedSphereTileCreate() routine
grid = ESMF_GridCreate(distgrid, coordSys=ESMF_COORDSYS_SPH_DEG, &
coordTypeKind=coordTypeKindLocal, &
indexflag=localIndexFlag, name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(staggerLocList)) then
do s=1, size(staggerLocList)
call ESMF_GridAddCoord(grid, staggerloc=staggerLocList(s), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
! calculate the actual cubed sphere coordiantes for each DE
do localDe = 0,decount-1
DeNo = demap(localDe)
tile = DeNo/(nx*ny)+1
rem = mod(DeNo,nx*ny)
sizei = sizex/nx
sizej = sizey/ny
rem1 = mod(sizex, nx)
rem2 = mod(sizey, ny)
ind = mod(rem,nx)
if (rem1 > 0) then
if (ind < rem1) then
sizei=sizei+1
starti=sizei*ind+1
else
starti=sizei*ind+rem1+1
endif
else
starti = sizei*ind+1
endif
ind = rem/nx
if (rem2 > 0) then
if (ind < rem2) then
sizej=sizej+1
startj=sizej*ind+1
else
startj=sizej*ind+rem2+1
endif
else
startj = sizej*ind+1
endif
!print *, DeNo, 'block:', starti, startj, sizei, sizej, tile
start(1)=starti
start(2)=startj
!count(1)=sizei
!count(2)=sizej
do s=1, size(staggerLocList)
if (coordTypeKindLocal == ESMF_TYPEKIND_R8) then
call ESMF_GridGetCoord(grid, coordDim=1, localDe=localDe, &
staggerloc=staggerLocList(s), farrayPtr=lonPtrR8, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
count=ubound(lonPtrR8)-lbound(lonPtrR8)+1
call ESMF_GridGetCoord(grid, coordDim=2, localDe=localDe, &
staggerloc=staggerLocList(s), farrayPtr=latPtrR8, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!call ESMF_VMWtime(starttime, rc=localrc)
! Generate glocal edge coordinates and local center coordinates
! need to adjust the count???
totallen = len_trim(mosaic%filenames(tile))+len_trim(mosaic%tileDirectory)
tempname = trim(mosaic%tileDirectory)//trim(mosaic%filenames(tile))
call ESMF_GridSpecReadStagger(trim(tempname),sizex, sizey, lonPtrR8, latPtrR8, &
staggerLoc=staggerLocList(s), &
start=start, count=count, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
call ESMF_GridGetCoord(grid, coordDim=1, localDe=localDe, &
staggerloc=staggerLocList(s), farrayPtr=lonPtrR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
count=ubound(lonPtrR4)-lbound(lonPtrR4)+1
call ESMF_GridGetCoord(grid, coordDim=2, localDe=localDe, &
staggerloc=staggerLocList(s), farrayPtr=latPtrR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!call ESMF_VMWtime(starttime, rc=localrc)
! Generate glocal edge coordinates and local center coordinates
! need to adjust the count???
totallen = len_trim(mosaic%filenames(tile))+len_trim(mosaic%tileDirectory)
tempname = trim(mosaic%tileDirectory)//trim(mosaic%filenames(tile))
call ESMF_GridSpecReadStagger(trim(tempname),sizex, sizey, lonPtrR4, latPtrR4, &
staggerLoc=staggerLocList(s), &
start=start, count=count, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
enddo
!call ESMF_VMWtime(starttime, rc=localrc)
!call ESMF_GridSpecReadTile(trim(tempname),sizex, sizey, lonPtr, latPtr, &
! cornerLon=lonCornerPtr, cornerLat=latCornerPtr, &
! start=start, count=count, rc=localrc)
!if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
! ESMF_CONTEXT, rcToReturn=rc)) return
!call ESMF_VMWtime(endtime, rc=localrc)
!print *, 'Create CS size ', sizex, sizey, 'in', (endtime-starttime)*1000.0, ' msecs'
enddo !localDe
endif !present(staggerLocList)
! Create another distgrid with user specified decomposition
if (present(decompflagPTile) .or. present(regDecompPTile) .or. &
present(delabelList) .or. present(delayout)) then
newdistgrid = ESMF_DistGridCreate(&
minIndexPTile=minIndexPTile, maxIndexPTile=maxIndexPTile, &
regDecompPTile=regDecompPTile, &
decompflagPTile=decompflagPTile, &
delabelList = delabelList, &
indexflag=ESMF_INDEX_DELOCAL, connectionList=connectionList, &
delayout = delayout, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
newgrid = ESMF_GridCreate(grid, newdistgrid, name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Destroy old grid
call ESMF_GridDestroy(grid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Destroy old distgrid
call ESMF_DistGridDestroy(distgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
ESMF_GridCreateMosaicReg = newgrid
else
ESMF_GridCreateMosaicReg = grid
endif
! - deallocate connectionList
deallocate(connectionList)
deallocate(minIndexPTile, maxIndexPTile)
else ! one tile case
! Figure out if it is a global grid or a regional grid
totallen = len_trim(mosaic%filenames(1))+len_trim(mosaic%tileDirectory)
tempname = trim(mosaic%tileDirectory)//trim(mosaic%filenames(1))
call ESMF_GridspecQueryTileGlobal(trim(tempname), isGlobal, rc=localrc)
if (present(regDecompPTile)) then
regDecomp = regDecompPTile(:,1)
else
! use default decomposition
regDecomp(1) = PetCnt
regDecomp(2) = 1
endif
totalDE = regDecomp(1)*regDecomp(2)
if (present(decompflagPTile)) then
decompflag = decompflagPTile(:,1)
else
decompflag = ESMF_DECOMP_BALANCED
endif
allocate(PetMap(regDecomp(1), regDecomp(2), 1))
allocate(PetMap1D(totalDE))
allocate(demap(0:totalDE-1))
if (present(delayout)) then
call ESMF_DELayoutGet(delayout, petMap = petMap1D, &
localDeCount=decount, localDeToDeMap=demap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
!Create a default delayout
defaultdelayout = ESMF_DELayoutCreate(decount=totalDE, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_DELayoutGet(defaultdelayout, petMap = petMap1D, &
localDeCount=decount, localDeToDeMap=demap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
k=1
do j=1,regDecomp(2)
do i=1,regDecomp(1)
PetMap(i,j,1)=PetMap1D(k)
k=k+1
enddo
enddo
deallocate(PetMap1D)
if (isGlobal) then
grid = ESMF_GridCreate1PeriDim(regDecomp, decompFlag, &
minIndex=(/1,1/), maxIndex=(/sizex,sizey/), &
indexflag=localIndexFlag, &
coordTypeKind=coordTypeKindLocal, &
coordSys=ESMF_COORDSYS_SPH_DEG, name=name, &
petMap = petMap, &
rc=localrc)
else
grid = ESMF_GridCreateNoPeriDim(regDecomp, decompFlag, &
minIndex=(/1,1/), maxIndex=(/sizex,sizey/), &
indexflag=localIndexFlag, &
coordTypeKind=coordTypeKindLocal, &
coordSys=ESMF_COORDSYS_SPH_DEG, name=name, &
petMap = petMap, &
rc=localrc)
endif
deallocate(PetMap)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGet(grid, distgrid=distgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(minIndexPDe(2,totalDE), maxIndexPDe(2,totalDE))
call ESMF_DistgridGet(distgrid, minIndexPDe=minIndexPDe, maxIndexPDe = maxIndexPDe, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(staggerLocList)) then
do s=1, size(staggerLocList)
if (coordTypeKindLocal == ESMF_TYPEKIND_R8) then
call ESMF_GridAddCoord(grid, staggerloc=staggerLocList(s), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
do localDe = 0,decount-1
call ESMF_GridGetCoord(grid, coordDim=1, localDe=localDe, &
staggerloc=staggerLocList(s), farrayPtr=lonPtrR8, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
start(1)=minIndexPDe(1,demap(localDe)+1)
start(2)=minIndexPDe(2,demap(localDe)+1)
count=ubound(lonPtrR8)-lbound(lonPtrR8)+1
call ESMF_GridGetCoord(grid, coordDim=2, localDe=localDe, &
staggerloc=staggerLocList(s), farrayPtr=latPtrR8, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!call ESMF_VMWtime(starttime, rc=localrc)
! Generate glocal edge coordinates and local center coordinates
! need to adjust the count???
call ESMF_GridSpecReadStagger(trim(tempname),sizex, sizey, lonPtrR8, latPtrR8, &
staggerLoc=staggerLocList(s), &
start=start, count=count, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
else !! R4
call ESMF_GridAddCoord(grid, staggerloc=staggerLocList(s), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
do localDe = 0,decount-1
call ESMF_GridGetCoord(grid, coordDim=1, localDe=localDe, &
staggerloc=staggerLocList(s), farrayPtr=lonPtrR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
start(1)=minIndexPDe(1,demap(localDe)+1)
start(2)=minIndexPDe(2,demap(localDe)+1)
count=ubound(lonPtrR4)-lbound(lonPtrR4)+1
call ESMF_GridGetCoord(grid, coordDim=2, localDe=localDe, &
staggerloc=staggerLocList(s), farrayPtr=latPtrR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!call ESMF_VMWtime(starttime, rc=localrc)
! Generate glocal edge coordinates and local center coordinates
! need to adjust the count???
call ESMF_GridSpecReadStagger(trim(tempname),sizex, sizey, lonPtrR4, latPtrR4, &
staggerLoc=staggerLocList(s), &
start=start, count=count, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
endif
enddo
endif
ESMF_GridCreateMosaicReg = grid
deallocate(minIndexPDe, maxIndexPDe)
endif
! Get rid of mosaic info
call ESMF_MosaicDestroy(mosaic, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
return
end function ESMF_GridCreateMosaicReg
!-------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateMosaicIReg()"
!BOP
! !IROUTINE: ESMF_GridCreateMosaic - Create a multi-tile Grid object with irregular decomposition using the grid definition from a GRIDSPEC Mosaic file.
! !INTERFACE:
function ESMF_GridCreateMosaicIReg(filename, &
countsPerDEDim1PTile, countsPerDEDim2PTile, &
keywordEnforcer, &
coordTypeKind, &
deLabelList, staggerLocList, &
delayout, indexflag, name, tileFilePath, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridCreateMosaicIReg
!
! !ARGUMENTS:
character(len=*), intent(in) :: filename
integer, intent(in) :: countsPerDEDim1PTile(:,:)
integer, intent(in) :: countsPerDEDim2PTile(:,:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: deLabelList(:)
type(ESMF_StaggerLoc), intent(in), optional :: staggerLocList(:)
type(ESMF_DELayout), intent(in), optional :: delayout
type(ESMF_Index_Flag), intent(in), optional :: indexflag
character(len=*), intent(in), optional :: name
character(len=*), intent(in), optional :: tileFilePath
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! Create a multiple-tile {\tt ESMF\_Grid} based on the definition from a GRIDSPEC Mosaic file and its associated
! tile files using irregular decomposition. Each tile can have different decomposition. The tile connections
! are defined in a GRIDSPEC format Mosaic file.
! And each tile's coordination is defined in a separate NetCDF file. The coordinates defined
! in the tile file is so-called "Super Grid". In other words, the dimensions of the coordinate variables are
! {\tt (2*xdim+1, 2*ydim+1)} if {\tt (xdim, ydim)} is the size of the tile. The Super Grid combines the corner,
! the edge and the center coordinates in one big array. A Mosaic file may contain just one tile. If a Mosaic contains
! multiple tiles. Each tile is a logically rectangular lat/lon grid. Currently, all the tiles have to be the same size.
! We will remove this limitation in the future release.
!
!
! The arguments are:
! \begin{description}
! \item[filename]
! The name of the GRIDSPEC Mosaic file.
! \item[countsPerDEDim1PTile]
! This array specifies the number of cells per DE for index dimension 1 for the
! center stagger location. The second index steps through the tiles. If each tile is
! decomposed into different number of DEs, the first dimension is the maximal DEs of
! all the tiles.
! \item[countsPerDEDim2PTile]
! This array specifies the number of cells per DE for index dimension 2 for the
! center stagger location. The second index steps through the tiles. If each tile is
! decomposed into different number of DEs, the first dimension is the maximal DEs of
! all the tiles.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. Only ESMF\_TYPEKIND\_R4
! and ESMF\_TYPEKIND\_R8 are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[deLabelList]}]
! List assigning DE labels to the default sequence of DEs. The default
! sequence is given by the column major order in the sequence as they appear
! in {\tt countsPerDEDim1PTile}, followed by {\tt countsPerDEDim2PTile}, then the
! tile index.
! \item[{[staggerLocList]}]
! The list of stagger locations to fill with coordinates. Please see Section~\ref{const:staggerloc}
! for a description of the available stagger locations. If not present, no coordinates
! will be added or filled.
! \item[{[delayout]}]
! Optional ESMF\_DELayout object to be used. If a delayout object is specified,
! the number of DEs must match with the total DEs defined in {\tt countsPerDEDim1PTile}
! and {\tt countsPerDEDim2PTile}.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[tileFilePath]}]
! Optional argument to define the path where the tile files reside. If it
! is given, it overwrites the path defined in {\tt gridlocation} variable
! in the mosaic file.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_VM) :: vm
integer :: PetNo, PetCnt
integer :: totalDE, nxy, nx, ny, bigFac
integer :: sizex, sizey
type(ESMF_DELayout) :: defaultDELayout
type(ESMF_Grid) :: grid, newgrid
type(ESMF_DistGrid) :: distgrid, newdistgrid
integer :: localrc
type(ESMF_DistGridConnection), allocatable :: connectionList(:)
integer :: i, j, k, conn
integer :: localDeCount, localDe, DeNo, tile
real(kind=ESMF_KIND_R8), pointer :: lonPtrR8(:,:), latPtrR8(:,:)
real(kind=ESMF_KIND_R8), pointer :: lonCornerPtrR8(:,:), latCornerPtrR8(:,:)
real(kind=ESMF_KIND_R4), pointer :: lonPtrR4(:,:), latPtrR4(:,:)
real(kind=ESMF_KIND_R4), pointer :: lonCornerPtrR4(:,:), latCornerPtrR4(:,:)
integer :: tileCount
integer :: connectionCount
integer :: tileSize
integer :: starti, startj, sizei, sizej
integer :: ind, rem, rem1, rem2
integer :: start(2), count(2)
integer, pointer :: minIndexPTile(:,:)
integer, pointer :: maxIndexPTile(:,:)
integer, pointer :: minIndexPDe(:,:)
integer, pointer :: maxIndexPDe(:,:)
integer, allocatable :: regDecomp2(:,:)
integer, allocatable :: demap(:)
integer :: decount
!real(ESMF_KIND_R8) :: starttime, endtime
character(len=ESMF_MAXPATHLEN) :: tempname
type(ESMF_Mosaic) :: mosaic
integer :: totallen
integer :: posVec(2), orientVec(2)
type(ESMF_Index_Flag) :: localIndexFlag
logical :: isGlobal
integer, pointer :: deBlockList(:,:,:), deToTileMap(:)
integer, pointer :: DeDim1(:), DeDim2(:)
integer :: t, minIndx, minIndy
integer, pointer :: PetMap1D(:), PetMap(:,:,:)
integer :: lbnd(2), ubnd(2)
integer :: tiles, totalelmt, s
type(ESMF_TypeKind_Flag) :: coordTypeKindLocal
if (present(rc)) rc=ESMF_SUCCESS
if (present(indexflag)) then
localIndexFlag = indexflag
else
localIndexFlag = ESMF_INDEX_DELOCAL
endif
! Set Default coordTypeKind
if (present(coordTypeKind)) then
if (coordTypeKind .ne. ESMF_TYPEKIND_R4 .and. &
coordTypeKind .ne. ESMF_TYPEKIND_R8) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- only ESMF_TYPEKIND_R4 and ESMF_TYPEKIND_R8 are allowed", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
coordTypeKindLocal=coordTypeKind
else
coordTypeKindLocal=ESMF_TYPEKIND_R8
endif
!------------------------------------------------------------------------
!------------------------------------------------------------------------
! get global vm information
!
call ESMF_VMGetCurrent(vm, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! set up local pet info
call ESMF_VMGet(vm, localPet=PetNo, petCount=PetCnt, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSpecReadMosaic(filename, mosaic, tileFilePath=tileFilePath, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
tileCount = mosaic%ntiles
sizex = mosaic%nx
sizey = mosaic%ny
if (tileCount > 1) then
! use local index for everytile
! should support different tile sizes -- TBD
allocate(minIndexPTile(2,tileCount))
allocate(maxIndexPTile(2,tileCount))
minIndexPTile(1,:)=1
minIndexPTile(2,:)=1
maxIndexPTile(1,:)=sizex
maxIndexPTile(2,:)=sizey
! build connectionList for each connecation
connectionCount = mosaic%ncontacts
allocate(connectionList(connectionCount))
do i=1,connectionCount
call calculateConnect(minIndexPTile, maxIndexPTile, mosaic%contact(:,i), &
mosaic%connindex(:,:,i), orientVec, posVec)
call ESMF_DistGridConnectionSet(connection=connectionList(i), &
tileIndexA=mosaic%contact(1,i), tileIndexB=mosaic%contact(2,i), &
positionVector=(/posVec(1), posVec(2)/), &
orientationVector = (/orientVec(1), orientVec(2)/), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
! calculate totalDE based on the decomposition
tiles=size(countsPerDEDim1PTile,2)
if (tiles /= 6) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- the second dimension of countsPerDEDim1PTile is not equal to 6", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (size(countsPerDEDim2PTile,2) /= 6) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- the second dimension of countsPerDEDim2PTile is not equal to 6", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
allocate(DeDim1(tiles), DeDim2(tiles))
do j=1,tiles
totalelmt = 0
DeDim1(j)=size(countsPerDEDim1Ptile,1)
DeDim2(j)=size(countsPerDEDim2Ptile,1)
do i=1,size(countsPerDEDim1PTile,1)
! check the total elements counts in dimension 1 is equal to sizex
! count how many DEs for this tile
totalelmt = countsPerDEDim1PTile(i,j)+totalelmt
if (countsPerDEDim1PTile(i,j)==0) then
DeDim1(j)=i-1
exit
endif
enddo
if (totalelmt /= sizex) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- the total number of elements in dimension 1 does not add up to size X", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
totalelmt = 0
do i=1,size(countsPerDEDim2PTile,1)
! check the total elements counts in dimension 1 is equal to tilesize
! count how many DEs for this tile
totalelmt = countsPerDEDim2PTile(i,j)+totalelmt
if (countsPerDEDim2PTile(i,j)==0) then
DeDim2(j)=i-1
exit
endif
enddo
if (totalelmt /= sizey) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- the total number of elements in dimension 2 does not add up to size Y", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
enddo
! calculate totalDE
totalDE=0
do j=1,tiles
totalDE = totalDE+DeDim1(j)*DeDim2(j)
enddo
if (present(indexflag)) then
localIndexFlag = indexflag
else
localIndexFlag = ESMF_INDEX_DELOCAL
endif
if (present(delayout)) then
!Check if delayout has the same number of DEs
call ESMF_DELayoutGet(delayout, deCount=deCount, rc=localrc)
if (deCount /= totalDE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- the total number of DEs specified in delayout is inconsistent with the decomposition arguments", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
defaultDELayout = delayout
else
defaultDELayout = ESMF_DELayoutCreate(deCount = totalDE, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
call ESMF_DELayoutGet(defaultDelayout, DeCount = decount, localDeCount=localDeCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (localDeCount > 0) then
allocate(demap(0:localDeCount-1))
call ESMF_DELayoutGet(defaultDElayout, localDeToDeMap = demap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!print *, PetNo, ' demap ', decount, demap
endif
! deBlockList and deToTileMap contains all the blocks for all the DEs (not
! just the localDEs
allocate(deBlockList(2,2,decount),deToTileMap(decount))
!print *, PetNo, 'total DE count ', decount
! minIndexPTile and maxIndexPTile are in ESMF_INDEX_GLOBAL, therefore, need
! to use global index in deBlockList as well
k=1
do t=1,tiles
do j=1,DeDim2(t)
do i=1,DeDim1(t)
minIndx = sum(countsPerDEDim1PTile(1:i-1,t))+minIndexPTile(1,t)
minIndy = sum(countsPerDEDim2PTile(1:j-1,t))+minIndexPTile(2,t)
deBlockList(1,1,k)=minIndx
deBlockList(2,1,k)=minIndy
deBlockList(1,2,k)=minIndx+countsPerDEDim1PTile(i,t)-1
deBlockList(2,2,k)=minIndy+countsPerDEDim2PTile(j,t)-1
deToTileMap(k)=t
k=k+1
enddo
enddo
enddo
! need to constrcut deBlockList and deToTileMap
distgrid = ESMF_DistGridCreate(&
minIndexPTile=minIndexPTile, maxIndexPTile=maxIndexPTile, &
deBlockList = deBlockList, deToTileMap = deToTileMap, &
indexflag=ESMF_INDEX_GLOBAL, connectionList=connectionList, &
deLabelList = deLabelList, &
delayout = defaultDelayout, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! - create Grid
! coordinates from the cubedSphereTileCreate() routine
grid = ESMF_GridCreate(distgrid, coordSys=ESMF_COORDSYS_SPH_DEG, &
coordTypeKind=coordTypeKindLocal, &
indexflag=localIndexFlag, name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(staggerLocList)) then
do s=1, size(staggerLocList)
call ESMF_GridAddCoord(grid, staggerloc=staggerLocList(s), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
! calculate the actual cubed sphere coordiantes for each DE
! calculate the actual cubed sphere coordiantes for each DE
do localDe = 0,localdecount-1
j = demap(localDe)+1
start(1)=deBlockList(1,1,j)-minIndexPTile(1,deToTileMap(j))+1
start(2)=deBlockList(2,1,j)-minIndexPTile(2,deToTileMap(j))+1
count(1)=deBlockList(1,2,j)-deBlockList(1,1,j)+1
count(2)=deBlockList(2,2,j)-deBlockList(2,1,j)+1
tile = deToTileMap(j)
do s=1, size(staggerLocList)
if (coordTypeKindLocal .eq. ESMF_TYPEKIND_R8) then
call ESMF_GridGetCoord(grid, coordDim=1, localDe=localDe, &
staggerloc=staggerLocList(s), farrayPtr=lonPtrR8, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
count=ubound(lonPtrR8)-lbound(lonPtrR8)+1
call ESMF_GridGetCoord(grid, coordDim=2, localDe=localDe, &
staggerloc=staggerLocList(s), farrayPtr=latPtrR8, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!call ESMF_VMWtime(starttime, rc=localrc)
! Generate glocal edge coordinates and local center coordinates
! need to adjust the count???
totallen = len_trim(mosaic%filenames(tile))+len_trim(mosaic%tileDirectory)
tempname = trim(mosaic%tileDirectory)//trim(mosaic%filenames(tile))
call ESMF_GridSpecReadStagger(trim(tempname),sizex, sizey, lonPtrR8, latPtrR8, &
staggerLoc=staggerLocList(s), &
start=start, count=count, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
call ESMF_GridGetCoord(grid, coordDim=1, localDe=localDe, &
staggerloc=staggerLocList(s), farrayPtr=lonPtrR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
count=ubound(lonPtrR4)-lbound(lonPtrR4)+1
call ESMF_GridGetCoord(grid, coordDim=2, localDe=localDe, &
staggerloc=staggerLocList(s), farrayPtr=latPtrR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!call ESMF_VMWtime(starttime, rc=localrc)
! Generate glocal edge coordinates and local center coordinates
! need to adjust the count???
totallen = len_trim(mosaic%filenames(tile))+len_trim(mosaic%tileDirectory)
tempname = trim(mosaic%tileDirectory)//trim(mosaic%filenames(tile))
call ESMF_GridSpecReadStagger(trim(tempname),sizex, sizey, lonPtrR4, latPtrR4, &
staggerLoc=staggerLocList(s), &
start=start, count=count, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
enddo
enddo
endif
ESMF_GridCreateMosaicIReg = grid
! - deallocate connectionList
deallocate(connectionList)
deallocate(minIndexPTile, maxIndexPTile)
deallocate(deBlockList,deToTileMap)
deallocate(DeDim1, DeDim2, demap)
else ! one tile case
! Figure out if it is a global grid or a regional grid
totallen = len_trim(mosaic%filenames(1))+len_trim(mosaic%tileDirectory)
tempname = trim(mosaic%tileDirectory)//trim(mosaic%filenames(1))
call ESMF_GridspecQueryTileGlobal(trim(tempname), isGlobal, rc=localrc)
allocate(PetMap1D(totalDE))
allocate(PetMap(size(countsPerDEDim1PTile,1),size(countsPerDEDim2PTile,1),1))
allocate(demap(0:totalDE-1))
totalDE=size(countsPerDEDim1PTile,1)*size(countsPerDEDim2PTile,1)
if (present(delayout)) then
!Check if delayout has the same number of DEs
call ESMF_DELayoutGet(delayout, deCount=deCount, rc=localrc)
if (deCount /= totalDE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- the total number of DEs specified in delayout is inconsistent with the decomposition arguments", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
call ESMF_DELayoutGet(delayout, petMap = petMap1D, &
localDeCount=decount, localDeToDeMap=demap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
k=1
do j=1,size(countsPerDEDim2PTile,1)
do i=1,size(countsPerDEDim1PTile,1)
PetMap(i,j,1)=PetMap1D(k)
k=k+1
enddo
enddo
else
! default DE layout
k=1
do j=1,size(countsPerDEDim2PTile,1)
do i=1,size(countsPerDEDim1PTile,1)
PetMap(i,j,1)=k
k=k+1
enddo
enddo
endif
if (isGlobal) then
grid = ESMF_GridCreate1PeriDim( &
countsPerDEDim1=countsPerDEDim1PTile(:,1), &
countsPerDEDim2=countsPerDEDim2PTile(:,1), &
indexflag=localIndexFlag, &
coordTypeKind=coordTypeKindLocal, &
coordSys=ESMF_COORDSYS_SPH_DEG, name=name, &
petMap = petMap, &
rc=localrc)
else
grid = ESMF_GridCreateNoPeriDim( &
countsPerDEDim1=countsPerDEDim1PTile(:,1), &
countsPerDEDim2=countsPerDEDim2PTile(:,1), &
indexflag=localIndexFlag, &
coordTypeKind=coordTypeKindLocal, &
coordSys=ESMF_COORDSYS_SPH_DEG, name=name, &
petMap = petMap, &
rc=localrc)
endif
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGet(grid, distgrid=distgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(minIndexPDe(2,totalDE), maxIndexPDe(2,totalDE))
call ESMF_DistgridGet(distgrid, minIndexPDe=minIndexPDe, maxIndexPDe = maxIndexPDe, &
delayout=defaultDElayout, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_DELayoutGet(defaultDelayout, localDeCount=localDeCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (localDeCount > 0) then
allocate(demap(0:localDeCount-1))
call ESMF_DELayoutGet(defaultDElayout, localDeToDeMap = demap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (present(staggerLocList)) then
do s=1, size(staggerLocList)
call ESMF_GridAddCoord(grid, staggerloc=staggerLocList(s), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
do localDe = 0,localDeCount-1
if (coordTypeKindLocal == ESMF_TYPEKIND_R8) then
call ESMF_GridGetCoord(grid, coordDim=1, localDe=localDe, &
staggerloc=staggerLocList(s), farrayPtr=lonPtrR8, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
start(1)=minIndexPDe(1,demap(localDe)+1)
start(2)=minIndexPDe(2,demap(localDe)+1)
count=ubound(lonPtrR8)-lbound(lonPtrR8)+1
call ESMF_GridGetCoord(grid, coordDim=2, localDe=localDe, &
staggerloc=staggerLocList(s), farrayPtr=latPtrR8, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!call ESMF_VMWtime(starttime, rc=localrc)
! Generate glocal edge coordinates and local center coordinates
! need to adjust the count???
call ESMF_GridSpecReadStagger(trim(tempname),sizex, sizey, lonPtrR8, latPtrR8, &
staggerLoc=staggerLocList(s), &
start=start, count=count, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else !R4
call ESMF_GridGetCoord(grid, coordDim=1, localDe=localDe, &
staggerloc=staggerLocList(s), farrayPtr=lonPtrR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
start(1)=minIndexPDe(1,demap(localDe)+1)
start(2)=minIndexPDe(2,demap(localDe)+1)
count=ubound(lonPtrR4)-lbound(lonPtrR4)+1
call ESMF_GridGetCoord(grid, coordDim=2, localDe=localDe, &
staggerloc=staggerLocList(s), farrayPtr=latPtrR4, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!call ESMF_VMWtime(starttime, rc=localrc)
! Generate glocal edge coordinates and local center coordinates
! need to adjust the count???
call ESMF_GridSpecReadStagger(trim(tempname),sizex, sizey, lonPtrR4, latPtrR4, &
staggerLoc=staggerLocList(s), &
start=start, count=count, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
!call ESMF_VMWtime(endtime, rc=localrc)
!print *, 'Create CS size ', nx, ny, 'in', (endtime-starttime)*1000.0, ' msecs'
enddo
enddo
endif
ESMF_GridCreateMosaicIReg = grid
deallocate(demap, petMap1D, petmap)
deallocate(minIndexPDe, maxIndexPDe)
endif
! Get rid of mosaic info
call ESMF_MosaicDestroy(mosaic, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
return
end function ESMF_GridCreateMosaicIreg
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "calculateConnect"
subroutine calculateConnect(minIndexPTile, maxIndexPTile, tilepair, &
contactTuple, orientationVector, positionVector)
integer, pointer :: minIndexPTile(:,:)
integer, pointer :: maxIndexPTile(:,:)
integer, intent(IN) :: tilepair(2)
integer, intent(IN) :: contactTuple(2,4)
integer, intent(OUT) :: orientationVector(2)
integer, intent(OUT) :: positionVector(2)
integer :: minIndexPair(2,2)
integer :: maxIndexPair(2,2)
integer :: pA(2) ! tile A start point
integer :: pB(2) ! tile A end point
integer :: pC(2) ! tile B start point (connect with point A)
integer :: pD(2) ! tile B end point (connect with point B)
! -- helper variables for conversion
integer :: i, dimCount=2
integer :: a(2), b(2)
integer :: pAplus(2), pAplusrot(2)
integer :: a_zero, a_notzero
integer :: b_zero, b_notzero
minIndexPair(:,1)=minIndexPTile(:,tilepair(1))
minIndexPair(:,2)=minIndexPTile(:,tilepair(2))
maxIndexPair(:,1)=maxIndexPTile(:,tilepair(1))
maxIndexPair(:,2)=maxIndexPTile(:,tilepair(2))
! -- resulting DistGrid orientation vector and position vector aruments
! --- convesion from pA, pB, pC, pD --> orientationVector, positionVector
pA = contactTuple(:,1)
pB = contactTuple(:,2)
pC = contactTuple(:,3)
pD = contactTuple(:,4)
a = pB - pA ! contact vector on tile A
b = pD - pC ! contact vector on tile B
!print *, "a=", a
!print *, "b=", b
a_zero = -1 ! invalidate
a_notzero = -1 ! invalidate
do i=1, dimCount
if (a(i)==0) then
a_zero=i
else
a_notzero = i
endif
enddo
if (a_zero==-1 .or. a_notzero==-1) then
call ESMF_LogSetError(ESMF_RC_ARG_BAD, &
msg="Contact for tile A must line up with index space.")
return
endif
b_zero = -1 ! invalidate
b_notzero = -1 ! invalidate
do i=1, dimCount
if (b(i)==0) then
b_zero=i
else
b_notzero = i
endif
enddo
if (b_zero==-1 .or. b_notzero==-1) then
call ESMF_LogSetError(ESMF_RC_ARG_BAD, &
msg="Contact for tile B must line up with index space.")
return
endif
!print *, "a_zero=", a_zero, " a_notzero=", a_notzero
!print *, "b_zero=", b_zero, " b_notzero=", b_notzero
if (abs(a(a_notzero)) /= abs(b(b_notzero))) then
call ESMF_LogSetError(ESMF_RC_ARG_BAD, &
msg="Contact must have same number of elements on both sides.")
return
endif
! construct preliminary orientationVector
orientationVector(b_zero) = a_zero
orientationVector(b_notzero) = a_notzero
! consider sign flip along contact
if (a(a_notzero) == -b(b_notzero)) then
orientationVector(b_notzero) = - orientationVector(b_notzero)
endif
! consider sign flip perpendicular to contact
if ((pA(a_zero)==minindexPair(a_zero,1) .and. &
pC(b_zero)==minindexPair(b_zero,2)) .or. &
(pA(a_zero)==maxIndexPair(a_zero,1) .and. &
pC(b_zero)==maxIndexPair(b_zero,2))) then
orientationVector(b_zero) = - orientationVector(b_zero)
endif
! done constructing orientationVector
! print *, ">>>>> orientationVector=", orientationVector, " <<<<<"
! now construct positionVector....
! The contact connects pA "+1" (on tile A) to pC (on tile B). The "+1" here
! means that one step beyond tile A is taken. This step is perpendicular to
! the contact vector, and outward from the tile.
pAplus = pA
if (pA(a_zero)==minindexPair(a_zero,1)) pAplus(a_zero) = pAplus(a_zero) - 1
if (pA(a_zero)==maxIndexPair(a_zero,1)) pAplus(a_zero) = pAplus(a_zero) + 1
!print *, "pAplus=", pAplus
! now apply the previously determined orientationVector on pAplus
do i=1, dimCount
if (orientationVector(i) < 0) then
pAplusrot(i) = -pAplus(-orientationVector(i))
else
pAplusrot(i) = pAplus(orientationVector(i))
endif
enddo
!print *, "pAplusrot=", pAplusrot
! find positionVector per definition as the difference
positionVector = pC - pAplusrot
!print *, ">>>>> positionVector= ", positionVector, " <<<<<"
end subroutine calculateConnect
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridDestroy"
!BOP
! !IROUTINE: ESMF_GridDestroy - Release resources associated with a Grid
! !INTERFACE:
subroutine ESMF_GridDestroy(grid, keywordEnforcer, noGarbage, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(inout) :: grid
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
logical, intent(in), optional :: noGarbage
integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \item\apiStatusModifiedSinceVersion{5.2.0r}
! \begin{description}
! \item[7.0.0] Added argument {\tt noGarbage}.
! The argument provides a mechanism to override the default garbage collection
! mechanism when destroying an ESMF object.
! \end{description}
! \end{itemize}
!
! !DESCRIPTION:
! Destroys an {\tt ESMF\_Grid} object and related internal structures.
! This call does destroy internally created DistGrid and DELayout classes,
! for example those created by {\tt ESMF\_GridCreateShapeTile()}. It also
! destroys internally created coordinate/item Arrays, for example those
! created by {\tt ESMF\_GridAddCoord()}. However, if the user uses an
! externally created class, for example creating an Array and setting it
! using {\tt ESMF\_GridSetCoord()}, then that class is not destroyed by
! this method.
!
! By default a small remnant of the object is kept in memory in order to
! prevent problems with dangling aliases. The default garbage collection
! mechanism can be overridden with the {\tt noGarbage} argument.
!
! The arguments are:
! \begin{description}
! \item[grid]
! {\tt ESMF\_Grid} to be destroyed.
! \item[{[noGarbage]}]
! If set to {\tt .TRUE.} the object will be fully destroyed and removed
! from the ESMF garbage collection system. Note however that under this
! condition ESMF cannot protect against accessing the destroyed object
! through dangling aliases -- a situation which may lead to hard to debug
! application crashes.
!
! It is generally recommended to leave the {\tt noGarbage} argument
! set to {\tt .FALSE.} (the default), and to take advantage of the ESMF
! garbage collection system which will prevent problems with dangling
! aliases or incorrect sequences of destroy calls. However this level of
! support requires that a small remnant of the object is kept in memory
! past the destroy call. This can lead to an unexpected increase in memory
! consumption over the course of execution in applications that use
! temporary ESMF objects. For situations where the repeated creation and
! destruction of temporary objects leads to memory issues, it is
! recommended to call with {\tt noGarbage} set to {\tt .TRUE.}, fully
! removing the entire temporary object from memory.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
!------------------------------------------------------------------------------
integer :: localrc ! local return code
type(ESMF_Logical) :: opt_noGarbage ! helper variable
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check init status of arguments
ESMF_INIT_CHECK_DEEP(ESMF_GridGetInit, grid, rc)
! Set default flags
opt_noGarbage = ESMF_FALSE
if (present(noGarbage)) opt_noGarbage = noGarbage
! Call F90/C++ interface subroutine
call c_ESMC_GridDestroy(grid, opt_noGarbage, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Mark this Grid object as invalid
grid%this = ESMF_NULL_POINTER
! Set init code
ESMF_INIT_SET_DELETED(grid)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridDestroy
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridEmptyCompleteEConnI"
!BOP
! !IROUTINE: ESMF_GridEmptyComplete - Complete a Grid with user set edge connections and an irregular distribution
! !INTERFACE:
! Private name; call using ESMF_GridEmptyComplete()
subroutine ESMF_GridEmptyCompleteEConnI(grid, minIndex, &
countsPerDEDim1,countsPerDeDim2, keywordEnforcer, &
countsPerDEDim3, &
connDim1, connDim2, connDim3, &
coordSys, coordTypeKind, &
coordDep1, coordDep2, coordDep3, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridMemLBound, indexflag, petMap, name, rc)
! !ARGUMENTS:
type (ESMF_Grid) :: grid
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: countsPerDEDim1(:)
integer, intent(in) :: countsPerDEDim2(:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(in), optional :: countsPerDEDim3(:)
type(ESMF_GridConn_Flag), intent(in), optional :: connDim1(:)
type(ESMF_GridConn_Flag), intent(in), optional :: connDim2(:)
type(ESMF_GridConn_Flag), intent(in), optional :: connDim3(:)
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(in), optional :: gridEdgeLWidth(:)
integer, intent(in), optional :: gridEdgeUWidth(:)
integer, intent(in), optional :: gridAlign(:)
integer, intent(in), optional :: gridMemLBound(:)
type(ESMF_Index_Flag), intent(in), optional :: indexflag
integer, intent(in), optional :: petMap(:,:,:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method takes in an empty Grid created by {\tt ESMF\_GridEmptyCreate()}.
! It then completes the grid to form a single tile, irregularly distributed grid
! (see Figure \ref{fig:GridDecomps}). To specify the irregular distribution, the user passes in an array
! for each grid dimension, where the length of the array is the number
! of DEs in the dimension. Currently this call only
! supports creating 2D or 3D Grids. A 2D Grid can be specified using the
! countsPerDEDim1 and countsPerDEDim2 arguments. A 3D Grid can
! be specified by also using the optional countsPerDEDim3 argument.
! The index of each array element in these arguments corresponds to
! a DE number. The array value at the index is the number of grid
! cells on the DE in that dimension.
!
! Section \ref{example:2DIrregUniGrid} shows an example
! of using an irregular distribution to create a 2D Grid with uniformly spaced
! coordinates. This creation method can also be used as the basis for
! grids with rectilinear coordinates or curvilinear coordinates.
!
! For consistency's sake the {\tt ESMF\_GridEmptyComplete()} call
! should be executed in the same set or a subset of the PETs in which the
! {\tt ESMF\_GridEmptyCreate()} call was made. If the call
! is made in a subset, the Grid objects outside that subset will
! still be "empty" and not usable.
!
! The arguments are:
! \begin{description}
! \item[grid]
! The empty {\tt ESMF\_Grid} to set information into and then commit.
! \item[{[minIndex]}]
! Tuple to start the index ranges at. If not present, defaults
! to /1,1,1,.../.
! \item[countsPerDEDim1]
! This arrays specifies the number of cells per DE for index dimension 1
! for the exclusive region (the center stagger location).
! \item[countsPerDEDim2]
! This array specifies the number of cells per DE for index dimension 2
! for the exclusive region (center stagger location).
! \item[{[countsPerDEDim3]}]
! This array specifies the number of cells per DE for index dimension 3
! for the exclusive region (center stagger location).
! If not specified then grid is 2D.
! \item[{[connDim1]}]
! Fortran array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! \item[{[connDim2]}]
! Fortran array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! \item[{[connDim3]}]
! Fortran array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! For a full list of options, please see Section~\ref{const:coordsys}.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[coordDep1]}]
! This array specifies the dependence of the first
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the first
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep2]}]
! This array specifies the dependence of the second
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the second
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep3]}]
! This array specifies the dependence of the third
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the third
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[gridEdgeLWidth]}]
! The padding around the lower edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 0, 0, ..., 0 (all zeros).
! \item[{[gridEdgeUWidth]}]
! The padding around the upper edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 1, 1, ..., 1 (all ones).
! \item[{[gridAlign]}]
! Specification of how the stagger locations should align with the cell
! index space (can be overridden by the individual staggerAligns). If
! the gridEdgeWidths are not specified than this argument
! implies the gridEdgeWidths. If the gridEdgeWidths are specified and this argument isn't
! then this argument is implied by the gridEdgeWidths.
! If this and the gridEdgeWidths are not specified, then defaults to
! -1, -1, ..., -1 (all negative ones).
! \item[{[gridMemLBound]}]
! Specifies the lower index range of the memory of every DE in this Grid.
! Only used when indexflag is {\tt ESMF\_INDEX\_USER}. May be overridden
! by staggerMemLBound.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[petMap]}]
! \begin{sloppypar}
! Sets the mapping of pets to the created DEs. This 3D
! should be of size size(countsPerDEDim1) x size(countsPerDEDim2) x
! size(countsPerDEDim3). If countsPerDEDim3 isn't present, then
! the last dimension is of size 1.
! \end{sloppypar}
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_DistGrid) :: distgrid
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer :: localrc
integer :: dimCount
integer, pointer :: gridEdgeLWidthLocal(:)
integer, pointer :: gridEdgeUWidthLocal(:)
integer, pointer :: gridAlignLocal(:)
integer, pointer :: minIndexLocal(:)
integer, pointer :: maxIndexLocal(:)
type(ESMF_DistgridConnection), pointer :: connList(:)
type(ESMF_CoordSys_Flag) :: coordSysLocal
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Get the dimension and extent of the index space
call GetIndexSpaceIrreg(minIndex, &
countsPerDEDim1,countsPerDeDim2, &
countsPerDEDim3, dimCount, minIndexLocal, maxIndexLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Build connection list
call SetupTileConn(dimCount, minIndexLocal, maxIndexLocal, &
connDim1, connDim2, connDim3, connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Create Irregular distgrid and error check associated input and set defaults
distgrid=ESMF_GridCreateDistgridIrreg(dimCount, minIndexLocal, maxIndexLocal, &
countsPerDEDim1,countsPerDeDim2, &
countsPerDEDim3, indexflag, petMap, connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set default widths and alignment and error check
allocate(gridEdgeLWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeLWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridEdgeUWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeUWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridAlignLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridAlignLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridLUADefault(dimCount, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridEdgeLWidthLocal, gridEdgeUWidthLocal, gridAlignLocal, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Convert coordDeps to coordDimCount and coordDimMap
allocate(coordDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimCount", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(coordDimMap(dimCount,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
call CoordInfoFromCoordDep(dimCount, coordDep1, coordDep2, coordDep3,&
coordDimCount, coordDimMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set Default coordSys
if (present(coordSys)) then
coordSysLocal=coordSys
else
coordSysLocal=ESMF_COORDSYS_SPH_DEG
endif
! Create Grid from specification
call ESMF_GridSetFromDistGrid( grid, &
distgrid=distgrid, &
coordSys=coordSysLocal, &
coordTypeKind=coordTypeKind, &
coordDimCount=coordDimCount, coordDimMap=coordDimMap, &
gridEdgeLWidth=gridEdgeLWidthLocal, &
gridEdgeUWidth=gridEdgeUWidthLocal, &
gridAlign=gridAlignLocal, &
gridMemLBound=gridMemLBound, &
indexflag=indexflag, &
name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Commit Grid -----------------------------------------------------------------
call ESMF_GridCommit(grid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set internal items to be destroyed with grid
Call ESMF_GridSetDestroyDistgrid(grid,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout(grid,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(connList)
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
deallocate(coordDimCount)
deallocate(coordDimMap)
deallocate(gridEdgeLWidthLocal)
deallocate(gridEdgeUWidthLocal)
deallocate(gridAlignLocal)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridEmptyCompleteEConnI
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridEmptyCompleteEConnR"
!BOP
! !IROUTINE: ESMF_GridEmptyComplete - Complete a Grid with user set edge connections and a regular distribution
! !INTERFACE:
! Private name; call using ESMF_GridEmptyComplete()
subroutine ESMF_GridEmptyCompleteEConnR(grid, regDecomp, decompFlag, &
minIndex, maxIndex, keywordEnforcer, &
connDim1, connDim2, connDim3, &
coordSys, coordTypeKind, &
coordDep1, coordDep2, coordDep3, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridMemLBound, indexflag, petMap, name, rc)
!!
! !ARGUMENTS:
type (ESMF_Grid) :: grid
integer, intent(in), optional :: regDecomp(:)
type(ESMF_Decomp_Flag), intent(in), optional :: decompflag(:)
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: maxIndex(:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_GridConn_Flag), intent(in), optional :: connDim1(:)
type(ESMF_GridConn_Flag), intent(in), optional :: connDim2(:)
type(ESMF_GridConn_Flag), intent(in), optional :: connDim3(:)
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(in), optional :: gridEdgeLWidth(:)
integer, intent(in), optional :: gridEdgeUWidth(:)
integer, intent(in), optional :: gridAlign(:)
integer, intent(in), optional :: gridMemLBound(:)
type(ESMF_Index_Flag), intent(in), optional :: indexflag
integer, intent(in), optional :: petMap(:,:,:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method takes in an empty Grid created by {\tt ESMF\_GridEmptyCreate()}.
! It then completes the grid to form a single tile, regularly distributed grid
! (see Figure \ref{fig:GridDecomps}).
! To specify the distribution, the user passes in an array
! ({\tt regDecomp}) specifying the number of DEs to divide each
! dimension into. The array {\tt decompFlag} indicates how the division into DEs is to
! occur. The default is to divide the range as evenly as possible. Currently this call
! only supports creating a 2D or 3D Grid, and thus, for example, {\tt maxIndex} must be of size 2 or 3.
!
! For consistency's sake the {\tt ESMF\_GridEmptyComplete()} call
! should be executed in the same set or a subset of the PETs in which the
! {\tt ESMF\_GridEmptyCreate()} call was made. If the call
! is made in a subset, the Grid objects outside that subset will
! still be "empty" and not usable.
!
! The arguments are:
! \begin{description}
! \item[grid]
! The empty {\tt ESMF\_Grid} to set information into and then commit.
! \item[{[regDecomp]}]
! List that has the same number of elements as {\tt maxIndex}.
! Each entry is the number of decounts for that dimension.
! If not specified, the default decomposition will be petCountx1x1..x1.
! \item[{[decompflag]}]
! List of decomposition flags indicating how each dimension of the
! tile is to be divided between the DEs. The default setting
! is {\tt ESMF\_DECOMP\_BALANCED} in all dimensions. Please see
! Section~\ref{const:decompflag} for a full description of the
! possible options. Note that currently the option
! {\tt ESMF\_DECOMP\_CYCLIC} isn't supported in Grid creation.
! \item[{[minIndex]}]
! The bottom extent of the grid array. If not given then the value defaults
! to /1,1,1,.../.
! \item[maxIndex]
! The upper extent of the grid array.
! \item[{[connDim1]}]
! Fortran array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! \item[{[connDim2]}]
! Fortran array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! \item[{[connDim3]}]
! Fortran array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! For a full list of options, please see Section~\ref{const:coordsys}.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[coordDep1]}]
! This array specifies the dependence of the first
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the first
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep2]}]
! This array specifies the dependence of the second
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the second
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep3]}]
! This array specifies the dependence of the third
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the third
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[gridEdgeLWidth]}]
! The padding around the lower edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 0, 0, ..., 0 (all zeros).
! \item[{[gridEdgeUWidth]}]
! The padding around the upper edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 1, 1, ..., 1 (all ones).
! \item[{[gridAlign]}]
! Specification of how the stagger locations should align with the cell
! index space (can be overridden by the individual staggerAligns). If
! the gridEdgeWidths are not specified than this argument
! implies the gridEdgeWidths. If the gridEdgeWidths are specified and this argument isn't
! then this argument is implied by the gridEdgeWidths.
! If this and the gridEdgeWidths are not specified, then defaults to
! -1, -1, ..., -1 (all negative ones).
! \item[{[gridMemLBound]}]
! Specifies the lower index range of the memory of every DE in this Grid.
! Only used when indexflag is {\tt ESMF\_INDEX\_USER}. May be overridden
! by staggerMemLBound.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[petMap]}]
! Sets the mapping of pets to the created DEs. This 3D
! should be of size regDecomp(1) x regDecomp(2) x regDecomp(3)
! If the Grid is 2D, then the last dimension is of size 1.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_DistGrid) :: distgrid
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer, pointer :: gridEdgeLWidthLocal(:)
integer, pointer :: gridEdgeUWidthLocal(:)
integer, pointer :: gridAlignLocal(:)
integer :: dimCount
integer, pointer :: minIndexLocal(:)
integer, pointer :: maxIndexLocal(:)
integer :: localrc
type(ESMF_DistgridConnection), pointer :: connList(:)
type(ESMF_CoordSys_Flag) :: coordSysLocal
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Get IndexSpace
call GetIndexSpaceReg(minIndex, maxIndex, &
dimCount, minIndexLocal, maxIndexLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Build connection list
call SetupTileConn(dimCount, minIndexLocal, maxIndexLocal, &
connDim1, connDim2, connDim3, connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Compute regular distgrid and error check associated input and set defaults
distgrid=ESMF_GridCreateDistgridReg(dimCount, minIndexLocal, maxIndexLocal, &
regDecomp, decompFlag, indexflag, petMap, connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set default widths and alignment and error check
allocate(gridEdgeLWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeLWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridEdgeUWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeUWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridAlignLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridAlignLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridLUADefault(dimCount, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridEdgeLWidthLocal, gridEdgeUWidthLocal, gridAlignLocal, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Convert coordDeps to coordDimCount and coordDimMap
allocate(coordDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimCount", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(coordDimMap(dimCount,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
call CoordInfoFromCoordDep(dimCount, coordDep1, coordDep2, coordDep3,&
coordDimCount, coordDimMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set Default coordSys
if (present(coordSys)) then
coordSysLocal=coordSys
else
coordSysLocal=ESMF_COORDSYS_SPH_DEG
endif
! Create Grid from specification
call ESMF_GridSetFromDistGrid( grid, &
distgrid=distgrid, &
coordSys=coordSysLocal, &
coordTypeKind=coordTypeKind, &
coordDimCount=coordDimCount, coordDimMap=coordDimMap, &
gridEdgeLWidth=gridEdgeLWidthLocal, &
gridEdgeUWidth=gridEdgeUWidthLocal, &
gridAlign=gridAlignLocal, &
gridMemLBound=gridMemLBound, &
indexflag=indexflag, &
name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Commit Grid -----------------------------------------------------------------
call ESMF_GridCommit(grid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set internal items to be destroyed with grid
call ESMF_GridSetDestroyDistgrid(grid,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout(grid,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(connList)
deallocate(coordDimCount)
deallocate(coordDimMap)
deallocate(gridEdgeLWidthLocal)
deallocate(gridEdgeUWidthLocal)
deallocate(gridAlignLocal)
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridEmptyCompleteEConnR
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridEmptyCompleteEConnA"
!BOP
! !IROUTINE: ESMF_GridEmptyComplete - Complete a Grid with user set edge connections and an arbitrary distribution
! !INTERFACE:
! Private name; call using ESMF_GridEmptyComplete()
subroutine ESMF_GridEmptyCompleteEConnA(grid, minIndex, maxIndex, &
arbIndexCount, arbIndexList, keywordEnforcer, &
connDim1, connDim2, connDim3, &
coordSys, coordTypeKind, &
coordDep1, coordDep2, coordDep3, &
distDim, name, rc)
!!
! !ARGUMENTS:
type (ESMF_Grid) :: grid
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: maxIndex(:)
integer, intent(in) :: arbIndexCount
integer, intent(in) :: arbIndexList(:,:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_GridConn_Flag), intent(in), optional :: connDim1(:)
type(ESMF_GridConn_Flag), intent(in), optional :: connDim2(:)
type(ESMF_GridConn_Flag), intent(in), optional :: connDim3(:)
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(in), optional :: distDim(:)
character (len=*), intent(in), optional :: name
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method takes in an empty Grid created by {\tt ESMF\_GridEmptyCreate()}.
! It then completes the grid to form a single tile, arbitrarily distributed grid
! (see Figure \ref{fig:GridDecomps}).
! To specify the arbitrary distribution, the user passes in an 2D array
! of local indices, where the first dimension is the number of local grid cells
! specified by {\tt localArbIndexCount} and the second dimension is the number of distributed
! dimensions.
!
! {\tt distDim} specifies which grid dimensions are arbitrarily distributed. The
! size of {\tt distDim} has to agree with the size of the second dimension of
! {\tt localArbIndex}.
!
! Currently this call
! only supports creating a 2D or 3D Grid, and thus, for example, {\tt maxIndex} must be of size 2 or 3.
!
! For consistency's sake the {\tt ESMF\_GridEmptyComplete()} call
! should be executed in the same set or a subset of the PETs in which the
! {\tt ESMF\_GridEmptyCreate()} call was made. If the call
! is made in a subset, the Grid objects outside that subset will
! still be "empty" and not usable.
!
! The arguments are:
! \begin{description}
! \item[grid]
! The empty {\tt ESMF\_Grid} to set information into and then commit.
! \item[{[minIndex]}]
! Tuple to start the index ranges at. If not present, defaults
! to /1,1,1,.../.
! \item[maxIndex]
! The upper extend of the grid index ranges.
! \item[arbIndexCount]
! The number of grid cells in the local DE. It is okay to have 0
! grid cell in a local DE.
! \item[arbIndexList]
! This 2D array specifies the indices of the PET LOCAL grid cells. The
! dimensions should be arbIndexCount * number of Distributed grid dimensions
! where arbIndexCount is the input argument specified below
! \item[{[connDim1]}]
! Fortran array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! \item[{[connDim2]}]
! Fortran array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! \item[{[connDim3]}]
! Fortran array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! For a full list of options, please see Section~\ref{const:coordsys}.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[coordDep1]}]
! The size of the array specifies the number of dimensions of the
! first coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. The format should be /ESMF\_GRID\_ARBDIM/ where
! /ESMF\_GRID\_ARBDIM/ is mapped to the collapsed 1D dimension from all
! the arbitrarily distributed dimensions. n is the dimension that
! is not distributed (if exists).
! If not present the default is /ESMF\_GRID\_ARBDIM/ if the first dimension
! is arbitararily distributed, or /n/ if not distributed (i.e. n=1)
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_GRID\_ARBDIM.
! \item[{[coordDep2]}]
! The size of the array specifies the number of dimensions of the
! second coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. The format should be /ESMF\_GRID\_ARBDIM/ where
! /ESMF\_GRID\_ARBDIM/ is mapped to the collapsed 1D dimension from all
! the arbitrarily distributed dimensions. n is the dimension that
! is not distributed (if exists).
! If not present the default is /ESMF\_GRID\_ARBDIM/ if this dimension
! is arbitararily distributed, or /n/ if not distributed (i.e. n=2)
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_GRID\_ARBDIM.
! \item[{[coordDep3]}]
! The size of the array specifies the number of dimensions of the
! third coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. The format should be /ESMF\_GRID\_ARBDIM/ where
! /ESMF\_GRID\_ARBDIM/ is mapped to the collapsed 1D dimension from all
! the arbitrarily distributed dimensions. n is the dimension that
! is not distributed (if exists).
! If not present the default is /ESMF\_GRID\_ARBDIM/ if this dimension
! is arbitararily distributed, or /n/ if not distributed (i.e. n=3)
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_GRID\_ARBDIM.
! \item[{[distDim]}]
! This array specifies which dimensions are arbitrarily distributed.
! The size of the array specifies the total distributed dimensions.
! if not specified, defaults is all dimensions will be arbitrarily
! distributed. The size has to agree with the size of the second
! dimension of {\tt localArbIndex}.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_DistGrid) :: distgrid
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer :: localrc
integer :: dimCount,distDimCount
integer :: i
integer, pointer :: indexArray(:,:)
logical, pointer :: isDistLocal(:)
integer, pointer :: distDimLocal(:)
integer, pointer :: minIndexLocal(:)
integer, pointer :: maxIndexLocal(:)
type(ESMF_DistgridConnection), pointer :: connList(:)
type(ESMF_CoordSys_Flag) :: coordSysLocal
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Get description of index space and what's undistributed
call GetIndexSpaceArb(minIndex, maxIndex, &
arbIndexCount, arbIndexList, distDim, &
dimCount, distDimCount, isDistLocal, distDimLocal, &
minIndexLocal, maxIndexLocal, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Build connection list
call SetupTileConn(dimCount, minIndexLocal, maxIndexLocal, &
connDim1, connDim2, connDim3, connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Create arbitrary distgrid
distgrid= ESMF_GridCreateDistgridArb(dimCount, distDimCount, isDistLocal, distDimLocal, &
minIndexLocal, maxIndexLocal, arbIndexCount, arbIndexList, connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Convert coordDeps to coordDimCount and coordDimMap
allocate(coordDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimCount", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(coordDimMap(dimCount,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
call CoordInfoFromCoordDepArb(dimCount, isDistLocal, coordDep1, coordDep2, coordDep3,&
coordDimCount, coordDimMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Put minIndex, maxIndex into indexArray for create from distgrid
allocate(indexArray(2,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating indexArray", &
ESMF_CONTEXT, rcToReturn=rc)) return
indexArray(1,:)=minIndexLocal(:)
indexArray(2,:)=maxIndexLocal(:)
! Set Default coordSys
if (present(coordSys)) then
coordSysLocal=coordSys
else
coordSysLocal=ESMF_COORDSYS_SPH_DEG
endif
! Create Grid from specification -----------------------------------------------
call ESMF_GridSetFromDistGrid(grid, coordTypeKind=coordTypeKind, &
distgrid=distgrid, &
minIndex=minIndexLocal, maxIndex=maxIndexLocal, &
distDim=distDimLocal, &
coordSys=coordSysLocal, &
coordDimCount=coordDimCount, coordDimMap=coordDimMap, &
localArbIndexCount=arbIndexCount, localArbIndex=arbIndexList, &
name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Commit Grid -----------------------------------------------------------------
call ESMF_GridCommit(grid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set internal items to be destroyed with grid
call ESMF_GridSetDestroyDistgrid(grid,destroy=.true., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout(grid,destroy=.false., &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(connList)
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
deallocate(isDistLocal)
deallocate(indexArray)
deallocate(distDimLocal)
deallocate(coordDimCount)
deallocate(coordDimMap)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridEmptyCompleteEConnA
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridEmptyCreate"
!BOP
! !IROUTINE: ESMF_GridEmptyCreate - Create a Grid that has no contents
! !INTERFACE:
function ESMF_GridEmptyCreate(keywordEnforcer, vm, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridEmptyCreate
!
! !ARGUMENTS:
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_VM), intent(in), optional :: vm
integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \item\apiStatusModifiedSinceVersion{5.2.0r}
! \begin{description}
! \item[7.1.0r] Added argument {\tt vm} to support object creation on a
! different VM than that of the current context.
! \end{description}
! \end{itemize}
!
! !DESCRIPTION:
! Partially create an {\tt ESMF\_Grid} object. This function allocates
! an {\tt ESMF\_Grid} object, but doesn't allocate any coordinate storage or other
! internal structures. The {\tt ESMF\_GridEmptyComplete()} calls
! can be used to set the values in the grid object and to construct the
! internal structure.
!
! The arguments are:
! \begin{description}
! \item[{[vm]}]
! If present, the Grid object is created on the specified
! {\tt ESMF\_VM} object. The default is to create on the VM of the
! current context.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
integer :: localrc ! local error status
type(ESMF_Grid) :: grid
! Initialize this grid object as invalid
grid%this = ESMF_NULL_POINTER
! Check init status of arguments
if (present(vm)) then
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_VMGetInit, vm, rc)
endif
! Call C++ Subroutine to do the create
call c_ESMC_gridcreateempty(grid%this, vm, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set return value
ESMF_GridEmptyCreate = grid
! Set init status
ESMF_INIT_SET_CREATED(ESMF_GridEmptyCreate)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridEmptyCreate
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetDefault"
!BOP
!\label{API:GridGet}
! !IROUTINE: ESMF_GridGet - Get object-wide Grid information
! !INTERFACE:
! Private name; call using ESMF_GridGet()
subroutine ESMF_GridGetDefault(grid, keywordEnforcer, coordTypeKind, &
dimCount, tileCount, staggerlocCount, localDECount, distgrid, &
distgridToGridMap, coordSys, coordDimCount, coordDimMap, arbDim, &
rank, arbDimCount, gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
indexFlag, status, name, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_TypeKind_Flag), intent(out), optional :: coordTypeKind
integer, intent(out), optional :: dimCount
integer, intent(out), optional :: tileCount
integer, intent(out), optional :: staggerlocCount
integer, intent(out), optional :: localDECount
type(ESMF_DistGrid), intent(out), optional :: distgrid
integer, target, intent(out), optional :: distgridToGridMap(:)
type(ESMF_CoordSys_Flag), intent(out), optional :: coordSys
integer, target, intent(out), optional :: coordDimCount(:)
integer, target, intent(out), optional :: coordDimMap(:,:)
integer, intent(out), optional :: arbDim
integer, intent(out), optional :: rank
integer, intent(out), optional :: arbDimCount
integer, target, intent(out), optional :: gridEdgeLWidth(:)
integer, target, intent(out), optional :: gridEdgeUWidth(:)
integer, target, intent(out), optional :: gridAlign(:)
type(ESMF_Index_Flag), intent(out), optional :: indexflag
type(ESMF_GridStatus_Flag),intent(out), optional :: status
character (len=*), intent(out), optional :: name
integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \end{itemize}
!
! !DESCRIPTION:
! Gets various types of information about a grid.
!
!The arguments are:
!\begin{description}
!\item[grid]
! Grid to get the information from.
!\item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
!\item[{[dimCount]}]
! DimCount of the Grid object.
!\item[{[tileCount]}]
! The number of logically rectangular tiles in the grid.
!\item[{[staggerlocCount]}]
! The number of stagger locations.
!\item[{[localDECount]}]
! The number of DEs in this grid on this PET.
!\item[{[distgrid]}]
! The structure describing the distribution of the grid.
!\item[{[distgridToGridMap]}]
! List that has as many elements as the distgrid dimCount. This array describes
! mapping between the grids dimensions and the distgrid.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! \item[{[coordDimCount]}]
! This argument needs to be of size equal to the Grid's dimCount.
! Each entry in the argument will be filled with the dimCount of the corresponding coordinate component (e.g. the
! dimCount of coordDim=1 will be put into entry 1).
! This is useful because it describes the factorization of the coordinate components in the Grid.
!\item[{[coordDimMap]}]
! 2D list of size grid dimCount x grid dimCount. This array describes the
! map of each component array's dimensions onto the grids
! dimensions.
! \item[{[arbDim]}]
! The distgrid dimension that is mapped by the arbitrarily distributed grid dimensions.
! \item[{[rank]}]
! The count of the memory dimensions, it is the same as dimCount for a non-arbitrarily distributed grid,
! and equal or less for a arbitrarily distributed grid.
! \item[{[arbDimCount]}]
! The number of dimensions distributed arbitrarily for an arbitrary grid, 0 if the grid is non-arbitrary.
! \item[{[gridEdgeLWidth]}]
! The padding around the lower edges of the grid. The array should
! be of size greater or equal to the Grid dimCount.
! \item[{[gridEdgeUWidth]}]
! The padding around the upper edges of the grid. The array should
! be of size greater or equal to the Grid dimCount.
! \item[{[gridAlign]}]
! Specification of how the stagger locations should align with the cell
! index space. The array should be of size greater or equal to the Grid dimCount.
! \item[{[indexflag]}]
! Flag indicating the indexing scheme being used in the Grid. Please
! see Section~\ref{const:indexflag} for the list of options.
! \item[{[status]}]
! Flag indicating the status of the Grid. Please
! see Section~\ref{const:gridstatus} for the list of options.
!\item[{[name]}]
! {\tt ESMF\_Grid} name.
!\item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
!\end{description}
!
!EOP
integer :: localrc ! local error status
type(ESMF_GridDecompType) :: decompType ! check if arbitrary
type(ESMF_InterArray) :: distgridToGridMapArg ! Language Interface Helper Var
type(ESMF_InterArray) :: coordDimCountArg ! Language Interface Helper Var
type(ESMF_InterArray) :: coordDimMapArg ! Language Interface Helper Var
type(ESMF_InterArray) :: gridEdgeLWidthArg ! Language Interface Helper Var
type(ESMF_InterArray) :: gridEdgeUWidthArg ! Language Interface Helper Var
type(ESMF_InterArray) :: gridAlignArg ! Language Interface Helper Var
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check init status of arguments
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, grid, rc)
! Get Grid decomposition type
call ESMF_GridGetDecompType(grid, decompType, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (decompType == ESMF_Grid_NONARBITRARY) then
if (present(arbDim)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- arbDim does not exist for a non-arbitrarily distributed grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! get name
if (present(name)) then
call c_ESMC_GetName(grid, name, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (present(coordTypeKind) .or. &
present(dimCount) .or. &
present(tileCount) .or. &
present(staggerlocCount) .or. &
present(localDECount) .or. &
present(distgrid) .or. &
present(distgridToGridMap) .or. &
present(coordDimCount) .or. &
present(coordDimMap) .or. &
present(coordSys) .or. &
present(arbDim) .or. &
present(rank) .or. &
present(arbDimCount) .or. &
present(gridEdgeLWidth) .or. &
present(gridEdgeUWidth) .or. &
present(gridAlign) .or. &
present(indexFlag)) then
!! coordTypeKind
! It doesn't look like it needs to be translated, but test to make sure
!! distgridToGridMap
distgridToGridMapArg = ESMF_InterArrayCreate(distgridToGridMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! Description of array factorization
coordDimCountArg = ESMF_InterArrayCreate(coordDimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
coordDimMapArg = ESMF_InterArrayCreate(farray2D=coordDimMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! Grid Boundary Info
gridEdgeLWidthArg = ESMF_InterArrayCreate(gridEdgeLWidth, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
gridEdgeUWidthArg = ESMF_InterArrayCreate(gridEdgeUWidth, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
gridAlignArg = ESMF_InterArrayCreate(gridAlign, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Call C++ Subroutine to do the get
call c_ESMC_gridget(grid%this, &
coordTypeKind, dimCount, tileCount, distgrid, staggerlocCount, &
distgridToGridMapArg, coordSys, coordDimCountArg, arbDim, &
rank, arbDimCount, coordDimMapArg, &
gridEdgeLWidthArg, gridEdgeUWidthArg, gridAlignArg, &
indexflag, localDECount, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate helper variables
call ESMF_InterArrayDestroy(distgridToGridMapArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(coordDimCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(coordDimMapArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(gridEdgeLWidthArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(gridEdgeUWidthArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(gridAlignArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set Deep Classes as created
if (present(distgrid)) then
call ESMF_DistGridSetInitCreated(distgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
endif
! Call C++ Subroutine to get the status
if (present(status)) then
call c_ESMC_gridgetstatus(grid%this, status)
endif
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridGetDefault
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetIndex"
!BOPI
! !IROUTINE: ESMF_GridGet - Get information about the min and max index of the grid dimension
! !INTERFACE:
! Private name; call using ESMF_GridGet()
subroutine ESMF_GridGetIndex(grid, tileNo, minIndex, maxIndex, rc)
!
! !Arguments:
type(ESMF_Grid), intent(in) :: grid
integer, intent(in), optional :: tileNo
integer,target, intent(out), optional :: minIndex(:)
integer,target, intent(out) :: maxIndex(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTON:
! This method gets the minimal index and maximal index of a given tile of the grid
!The arguments are:
!\begin{description}
!\item[{grid}]
! Grid to get the information from.
!\item[{[tileNo]}]
! The tile number from which to get the information. The default is 0.
!\item[{[minIndex]}]
! The minimal grid index for the given tile.
!\item[{[maxIndex]}]
! The maximal grid index for the given tile.
!\item[{[rc]}]
! The return value.
!\end{description}
!
!EOPI
integer :: localrc ! local error status
type(ESMF_InterArray) :: minIndexArg ! helper variable
type(ESMF_InterArray) :: maxIndexArg ! helper variable
type(ESMF_GridDecompType) :: decompType
integer :: localTileNo ! local TileNo
! 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_SHORT(ESMF_GridGetInit, grid, rc)
if (present(tileNo)) then
! Get Grid decomposition type
call ESMF_GridGetDecompType(grid, decompType, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if ((decompType == ESMF_GRID_ARBITRARY) .and. &
(tileNo /= 1)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- tileNo has to be 1 for arbitrarily distributed grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
elseif (tileNo /= 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- multiple tiles is not implemented", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
localTileNo = tileNo
else
localTileNo = 1
endif
! process optional arguments
minIndexArg=ESMF_InterArrayCreate(minIndex, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
maxIndexArg=ESMF_InterArrayCreate(maxIndex, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call c_ESMC_gridgetindex(grid, localTileNo, minIndexArg, maxIndexArg, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate interface ints
call ESMF_InterArrayDestroy(minIndexArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(maxIndexArg, 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_GridGetIndex
! XMRKX
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetPLocalDe"
!BOP
!\label{API:GridGetPLocalDe}
! !IROUTINE: ESMF_GridGet - Get DE-local Grid information
! !INTERFACE:
! Private name; call using ESMF_GridGet()
subroutine ESMF_GridGetPLocalDe(grid, localDE, keywordEnforcer, &
isLBound,isUBound, arbIndexCount, arbIndexList, tile, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
integer, intent(in) :: localDE
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
logical, intent(out), optional :: isLBound(:)
logical, intent(out), optional :: isUBound(:)
integer, intent(out), optional :: arbIndexCount
integer, target, intent(out), optional :: arbIndexList(:,:)
integer, intent(out), optional :: tile
integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \item\apiStatusModifiedSinceVersion{5.2.0r}
! \begin{description}
! \item[7.1.0r] Added argument {\tt tile}. This new argument allows the user to
! query the tile within which the localDE is contained.
! \end{description}
! \end{itemize}
!
! !DESCRIPTION:
! This call gets information about a particular local DE in a Grid.
!
!The arguments are:
!\begin{description}
!\item[grid]
! Grid to get the information from.
!\item[localDE]
! The local DE from which to get the information. {\tt [0,..,localDECount-1]}
!\item[{[isLBound]}]
! Upon return, for each dimension this indicates if the DE is a lower bound of the Grid.
! {\tt isLBound} must be allocated to be of size equal to the Grid dimCount.
!\item[{[isUBound]}]
! Upon return, for each dimension this indicates if the DE is an upper bound of the Grid.
! {\tt isUBound} must be allocated to be of size equal to the Grid dimCount.
! \item[{[arbIndexCount]}]
! The number of local cells for an arbitrarily distributed grid
! \item[{[arbIndexList]}]
! The 2D array storing the local cell indices for an arbitrarily distributed grid. The size of the array
! is arbIndexCount * arbDimCount
!\item[{[tile]}]
! The number of the tile in which localDE is contained. Tile numbers range from 1 to TileCount.
!\item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
!\end{description}
!
!EOP
integer :: localrc ! local error status
integer :: isLBoundTmp(ESMF_MAXDIM)
integer :: isUBoundTmp(ESMF_MAXDIM)
integer :: dimCount,i
type(ESMF_GridDecompType) :: decompType ! check if arbitrary
type(ESMF_InterArray) :: arbIndexListArg ! Language Interface Helper Var
! 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_SHORT(ESMF_GridGetInit, grid, rc)
! Get Grid decomposition type
call ESMF_GridGetDecompType(grid, decompType, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (decompType == ESMF_Grid_NONARBITRARY) then
if (present(arbIndexCount) .or. present(arbIndexList)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- arbIndexCount, or arbIndexList do not exist for a non-arbitrarily distributed grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else if (decompType == ESMF_Grid_ARBITRARY) then
if (present(isUBound) .or. present(isLBound)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- isLBound and/or isUBound not supported for arbitrary Grids", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! Get Grid Dimension
call ESMF_GridGet(grid, dimCount=dimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Error check input
if (present(isLBound)) then
if (size(isLBound) < dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_RANK, &
msg="- isLBound must have at least the same size as the grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(isUBound)) then
if (size(isUBound) < dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_RANK, &
msg="- isUBound must have at least the same size as the grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
!! Arbitrarily distributed grid local indices
arbIndexListArg = ESMF_InterArrayCreate(farray2D=arbIndexList, 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_GridGetPLocalDe(grid, localDE, &
dimCount, isLBoundTmp, isUBoundTmp, arbIndexCount, arbIndexListArg, &
tile, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Process return values
if (present(isLBound)) then
isLBound=.false.
do i=1,dimCount
if (isLBoundTmp(i) == 1) isLBound(i)=.true.
enddo
endif
if (present(isUBound)) then
isUBound=.false.
do i=1,dimCount
if (isUBoundTmp(i) == 1) isUBound(i)=.true.
enddo
endif
call ESMF_InterArrayDestroy(arbIndexListArg, 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_GridGetPLocalDe
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetPLocalDePSloc"
!BOP
!\label{API:GridGetPLocalDePSloc}
! !IROUTINE: ESMF_GridGet - Get DE-local information for a specific stagger location in a Grid
! !INTERFACE:
! Private name; call using ESMF_GridGet()
subroutine ESMF_GridGetPLocalDePSloc(grid, staggerloc, localDE, &
keywordEnforcer, exclusiveLBound, exclusiveUBound, exclusiveCount, &
computationalLBound, computationalUBound, computationalCount, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type (ESMF_StaggerLoc), intent(in) :: staggerloc
integer, intent(in) :: localDE
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, target, intent(out), optional :: exclusiveLBound(:)
integer, target, intent(out), optional :: exclusiveUBound(:)
integer, target, intent(out), optional :: exclusiveCount(:)
integer, target, intent(out), optional :: computationalLBound(:)
integer, target, intent(out), optional :: computationalUBound(:)
integer, target, intent(out), optional :: computationalCount(:)
integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \end{itemize}
!
! !DESCRIPTION:
! This method gets information about the range of index space which a
! particular stagger location occupies. This call differs from the coordinate
! bound calls (e.g. {\tt ESMF\_GridGetCoord}) in that a given coordinate
! array may only occupy a subset of the Grid's dimensions, and
! so these calls may not give all the bounds of the stagger location.
! The bounds from this call are the full bounds, and so
! for example, give the appropriate bounds for allocating a Fortran array to hold
! data residing on the stagger location.
! Note that unlike the output from the Array, these values also include the
! undistributed dimensions and are
! ordered to reflect the order of the indices in the Grid. This call will
! still give correct values even if the stagger location does not contain
! coordinate arrays (e.g. if {\tt ESMF\_GridAddCoord} hasn't yet
! been called on the stagger location).
!
!The arguments are:
!\begin{description}
!\item[grid]
! Grid to get the information from.
!\item[staggerloc]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations.
!\item[localDE]
! The local DE from which to get the information. {\tt [0,..,localDECount-1]}
!\item[{[exclusiveLBound]}]
! Upon return this holds the lower bounds of the exclusive region.
! {\tt exclusiveLBound} must be allocated to be of size equal to the Grid dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
!\item[{[exclusiveUBound]}]
! Upon return this holds the upper bounds of the exclusive region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the Grid dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
!\item[{[exclusiveCount]}]
! Upon return this holds the number of items,{\tt exclusiveUBound-exclusiveLBound+1},
! in the exclusive region per dimension.
! {\tt exclusiveCount} must
! be allocated to be of size equal to the Grid dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
!\item[{[computationalLBound]}]
! \begin{sloppypar}
! Upon return this holds the lower bounds of the computational region.
! {\tt computationalLBound} must be allocated to be of size equal to the Grid dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \end{sloppypar}
!\item[{[computationalUBound]}]
! \begin{sloppypar}
! Upon return this holds the upper bounds of the computational region.
! {\tt computationalUBound} must be allocated to be of size equal to the Grid dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \end{sloppypar}
!\item[{[computationalCount]}]
! \begin{sloppypar}
! Upon return this holds the number of items in the computational region per dimension.
! (i.e. {\tt computationalUBound-computationalLBound+1}). {\tt computationalCount} must
! be allocated to be of size equal to the Grid dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \end{sloppypar}
!\item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
!\end{description}
!
!EOP
integer :: localrc ! local error status
type(ESMF_InterArray) :: exclusiveLBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveUBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveCountArg ! helper variable
type(ESMF_InterArray) :: computationalLBoundArg ! helper variable
type(ESMF_InterArray) :: computationalUBoundArg ! helper variable
type(ESMF_InterArray) :: computationalCountArg ! helper variable
integer :: tmp_staggerloc
! 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_SHORT(ESMF_GridGetInit, grid, rc)
tmp_staggerloc=staggerloc%staggerloc
! process optional arguments
exclusiveLBoundArg=ESMF_InterArrayCreate(exclusiveLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveUBoundArg=ESMF_InterArrayCreate(exclusiveUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveCountArg=ESMF_InterArrayCreate(exclusiveCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalLBoundArg=ESMF_InterArrayCreate(computationalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalUBoundArg=ESMF_InterArrayCreate(computationalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalCountArg=ESMF_InterArrayCreate(computationalCount, 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_GridGetPLocalDePSloc(grid, localDE, tmp_staggerLoc, &
exclusiveLBoundArg, exclusiveUBoundArg, exclusiveCountArg, &
computationalLBoundArg, computationalUBoundArg, computationalCountArg, &
localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate interface ints
call ESMF_InterArrayDestroy(exclusiveLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalCountArg, 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_GridGetPLocalDePSloc
!------------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetPSloc"
!BOP
!\label{API:GridGetPSloc}
! !IROUTINE: ESMF_GridGet - Get information about a specific stagger location in a Grid
! !INTERFACE:
! Private name; call using ESMF_GridGet()
subroutine ESMF_GridGetPSloc(grid, staggerloc, &
keywordEnforcer, distgrid, &
staggerEdgeLWidth, staggerEdgeUWidth, &
staggerAlign, staggerLBound, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type (ESMF_StaggerLoc), intent(in) :: staggerloc
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_DistGrid), intent(out), optional :: distgrid
integer, intent(out), optional :: staggerEdgeLWidth(:)
integer, intent(out), optional :: staggerEdgeUWidth(:)
integer, intent(out), optional :: staggerAlign(:)
integer, intent(out), optional :: staggerLBound(:)
integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \item\apiStatusModifiedSinceVersion{5.2.0r}
! \begin{description}
! \item[7.1.0r] Added arguments {\tt staggerEdgeLWidth}, {\tt staggerEdgeUWidth},
! {\tt staggerAlign}, and {\tt staggerLBound}. These new arguments
! allow the user to get width, alignment, and bound information for
! the given stagger location.
! \end{description}
! \end{itemize}
!
! !DESCRIPTION:
! This method gets information about a particular stagger location.
! This information is useful for creating an ESMF Array to hold
! the data at the stagger location.
!
!The arguments are:
!\begin{description}
!\item[grid]
! Grid to get the information from.
!\item[staggerloc]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations.
!\item[{[distgrid]}]
! The structure describing the distribution of this staggerloc in this grid.
! \item[{[staggerEdgeLWidth]}]
! This array should be the same dimCount as the grid. It specifies the lower corner of the stagger
! region with respect to the lower corner of the exclusive region.
! \item[{[staggerEdgeUWidth]}]
! This array should be the same dimCount as the grid. It specifies the upper corner of the stagger
! region with respect to the upper corner of the exclusive region.
! \item[{[staggerAlign]}]
! This array is of size grid dimCount.
! For this stagger location, it specifies which element
! has the same index value as the center. For example,
! for a 2D cell with corner stagger it specifies which
! of the 4 corners has the same index as the center.
! \item[{[staggerLBound]}]
! Specifies the lower index range of the memory of every DE in this staggerloc in this Grid.
! Only used when Grid indexflag is {\tt ESMF\_INDEX\_USER}.
!\item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
!\end{description}
!
!EOP
! XMRKX
integer :: localrc ! local error status
type(ESMF_InterArray) :: staggerEdgeLWidthArg ! helper variable
type(ESMF_InterArray) :: staggerEdgeUWidthArg ! helper variable
type(ESMF_InterArray) :: staggerAlignArg ! helper variable
type(ESMF_InterArray) :: staggerLBoundArg ! helper variable
integer :: tmp_staggerloc
! Initialize return code
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! If not asking for anything, then just leave
if (.not. present(distgrid) .and. &
.not. present(staggerEdgeLWidth) .and. &
.not. present(staggerEdgeUWidth) .and. &
.not. present(staggerAlign) .and. &
.not. present(staggerLBound)) then
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
return
endif
! Check init status of arguments
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, grid, rc)
tmp_staggerloc=staggerloc%staggerloc
! process optional arguments into interface ints
staggerEdgeLWidthArg=ESMF_InterArrayCreate(staggerEdgeLWidth, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
staggerEdgeUWidthArg=ESMF_InterArrayCreate(staggerEdgeUWidth, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
staggerAlignArg=ESMF_InterArrayCreate(staggerAlign, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
staggerLBoundArg=ESMF_InterArrayCreate(staggerLBound, 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_GridGetPSloc(grid, tmp_staggerLoc, &
distgrid, staggerEdgeLWidthArg, staggerEdgeUWidthArg, &
staggerAlignArg, staggerLBoundArg, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate interface ints
call ESMF_InterArrayDestroy(staggerEdgeLWidthArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(staggerEdgeUWidthArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(staggerAlignArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(staggerLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set Deep Classes as created
if (present(distgrid)) then
call ESMF_DistGridSetInitCreated(distgrid, 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_GridGetPSloc
!------------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetPSlocPTile"
!BOP
!\label{API:GridGetPSlocPTile}
! !IROUTINE: ESMF_GridGet - Get information about a specific stagger location and tile in a Grid
! !INTERFACE:
! Private name; call using ESMF_GridGet()
subroutine ESMF_GridGetPSlocPTile(grid, tile, staggerloc, &
keywordEnforcer, minIndex, maxIndex, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
integer, intent(in) :: tile
type (ESMF_StaggerLoc), intent(in) :: staggerloc
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, target, intent(out), optional :: minIndex(:)
integer, target, intent(out), optional :: maxIndex(:)
integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \end{itemize}
!
! !DESCRIPTION:
! This method gets information about a particular stagger location.
! This information is useful for creating an ESMF Array to hold
! the data at the stagger location.
!
!The arguments are:
!\begin{description}
!\item[grid]
! Grid to get the information from.
!\item[tile]
! The tile number to get the data from. Tile numbers range from 1 to TileCount.
!\item[staggerloc]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations.
!\item[{[minIndex]}]
! Upon return this holds the global lower index of this stagger location.
! {\tt minIndex} must be allocated to be of size equal to the grid DimCount.
! Note that this value is only for the first Grid tile, as multigrid support
! is added, this interface will likely be changed or moved to adapt.
!\item[{[maxIndex]}]
! Upon return this holds the global upper index of this stagger location.
! {\tt maxIndex} must be allocated to be of size equal to the grid DimCount.
! Note that this value is only for the first Grid tile, as multigrid support
! is added, this interface will likely be changed or moved to adapt.
!\item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
!\end{description}
!
!EOP
integer :: localrc ! local error status
type(ESMF_InterArray) :: minIndexArg ! helper variable
type(ESMF_InterArray) :: maxIndexArg ! helper variable
integer :: tmp_staggerloc
! 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_SHORT(ESMF_GridGetInit, grid, rc)
tmp_staggerloc=staggerloc%staggerloc
! process optional arguments
minIndexArg=ESMF_InterArrayCreate(minIndex, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
maxIndexArg=ESMF_InterArrayCreate(maxIndex, 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_GridGetPSlocPTile(grid, tile, tmp_staggerLoc, &
minIndexArg, maxIndexArg,localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate interface ints
call ESMF_InterArrayDestroy(minIndexArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(maxIndexArg, 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_GridGetPSlocPTile
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetDecompType"
!BOPI
! !IROUTINE: ESMF_GridGetDecompType - Get decomposition type: arbitrary or not
! !INTERFACE:
subroutine ESMF_GridGetDecompType(grid, decompType, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type(ESMF_GridDecompType), intent(out) :: decompType
integer, intent(out), optional :: rc
!
integer :: localrc
call c_ESMC_gridGetDecompType(grid, decompType, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridGetDecompType
!------------------------------------------------------------------------------
!BOP
!\label{API:GridGetCoord}
! !IROUTINE: ESMF_GridGetCoord - Get a DE-local Fortran array pointer to Grid coord data and coord bounds
!
! !INTERFACE:
! subroutine ESMF_GridGetCoord<rank><type><kind>(grid, coordDim, keywordEnforcer, &
! staggerloc, localDE, farrayPtr, datacopyflag, &
! exclusiveLBound, exclusiveUBound, exclusiveCount, &
! computationalLBound, computationalUBound, computationalCount, &
! totalLBound, totalUBound, totalCount, rc)
!
! !ARGUMENTS:
! type(ESMF_Grid), intent(in) :: grid
! integer, intent(in) :: coordDim
!type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
! type (ESMF_StaggerLoc) intent(in), optional :: staggerloc
! integer, intent(in), optional :: localDE
! <type> (ESMF_KIND_<kind>), pointer :: farrayPtr(<rank>)
! type(ESMF_DataCopy_Flag), intent(in), optional :: datacopyflag
! integer, intent(out), optional :: exclusiveLBound(:)
! integer, intent(out), optional :: exclusiveUBound(:)
! integer, intent(out), optional :: exclusiveCount(:)
! integer, intent(out), optional :: computationalLBound(:)
! integer, intent(out), optional :: computationalUBound(:)
! integer, intent(out), optional :: computationalCount(:)
! integer, intent(out), optional :: totalLBound(:)
! integer, intent(out), optional :: totalUBound(:)
! integer, intent(out), optional :: totalCount(:)
! integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \end{itemize}
!
! !DESCRIPTION:
! This method gets a Fortran pointer to the piece of memory which holds the
! coordinate data on the local DE for the given coordinate dimension and stagger
! locations.
! This is useful, for example, for setting the coordinate values in a Grid, or
! for reading the coordinate values. Currently this method supports up to three
! coordinate dimensions, of either R4 or R8 datatype. See below for specific
! supported values. If the coordinates that you are trying to retrieve are of
! higher dimension, use the {\tt ESMF\_GetCoord()} interface that returns coordinate
! values in an {\tt ESMF\_Array} instead. That interface supports the retrieval of
! coordinates up to 7D.
!
! Supported values for the farrayPtr argument are:
! \begin{description}
! \item real(ESMF\_KIND\_R4), pointer :: farrayPtr(:)
! \item real(ESMF\_KIND\_R4), pointer :: farrayPtr(:,:)
! \item real(ESMF\_KIND\_R4), pointer :: farrayPtr(:,:,:)
! \item real(ESMF\_KIND\_R8), pointer :: farrayPtr(:)
! \item real(ESMF\_KIND\_R8), pointer :: farrayPtr(:,:)
! \item real(ESMF\_KIND\_R8), pointer :: farrayPtr(:,:,:)
! \end{description}
!
! The arguments are:
! \begin{description}
! \item[grid]
! Grid to get the information from.
! \item[coordDim]
! The coordinate dimension to get the data from (e.g. 1=x).
! \item[{[staggerloc]}]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! \item[{[localDE]}]
! The 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}]
! The pointer to the coordinate data.
! \item[{[datacopyflag]}]
! If not specified, default to {\tt ESMF\_DATACOPY\_REFERENCE}, in this case
! farrayPtr is a reference to the data in the Grid coordinate arrays.
! Please see Section~\ref{const:datacopyflag} for further description and a
! list of valid values.
! \item[{[exclusiveLBound]}]
! Upon return this holds the lower bounds of the exclusive region.
! {\tt exclusiveLBound} must be allocated to be of size equal to the coord dimCount.
! \item[{[exclusiveUBound]}]
! Upon return this holds the upper bounds of the exclusive region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the coord dimCount.
! \item[{[exclusiveCount]}]
! Upon return this holds the number of items, {\tt exclusiveUBound-exclusiveLBound+1},
! in the exclusive region per dimension.
! {\tt exclusiveCount} must
! be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalLBound]}]
! Upon return this holds the lower bounds of the stagger region.
! {\tt computationalLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalUBound]}]
! Upon return this holds the upper bounds of the stagger region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalCount]}]
! Upon return this holds the number of items in the computational region per dimension
! (i.e. {\tt computationalUBound-computationalLBound+1}). {\tt computationalCount}
! must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalLBound]}]
! Upon return this holds the lower bounds of the total region.
! {\tt totalLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalUBound]}]
! Upon return this holds the upper bounds of the total region.
! {\tt totalUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalCount]}]
! \begin{sloppypar}
! Upon return this holds the number of items in the total region per dimension
! (i.e. {\tt totalUBound-totalLBound+1}). {\tt totalCount} must
! be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \end{sloppypar}
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetCoord1DR4"
!BOPI
! !IROUTINE: ESMF_GridGetCoord - Get pointer to 1DR4 coordinates
! !INTERFACE:
! Private name; call using ESMF_GridGetCoord()
subroutine ESMF_GridGetCoord1DR4(grid, coordDim, keywordEnforcer, &
staggerloc, localDE, farrayPtr, datacopyflag, &
exclusiveLBound, exclusiveUBound, &
exclusiveCount, computationalLBound, computationalUBound, &
computationalCount, totalLBound, totalUBound, totalCount, &
rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
integer, intent(in) :: coordDim
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
integer, intent(in), optional :: localDE
real(ESMF_KIND_R4), pointer :: farrayPtr(:)
type(ESMF_DataCopy_Flag),intent(in), optional :: datacopyflag
integer, target, intent(out), optional :: exclusiveLBound(:)
integer, target, intent(out), optional :: exclusiveUBound(:)
integer, target, intent(out), optional :: exclusiveCount(:)
integer, target, intent(out), optional :: computationalLBound(:)
integer, target, intent(out), optional :: computationalUBound(:)
integer, target, intent(out), optional :: computationalCount(:)
integer, target, intent(out), optional :: totalLBound(:)
integer, target, intent(out), optional :: totalUBound(:)
integer, target, intent(out), optional :: totalCount(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This method gets a Fortran pointer to the piece of memory which holds the
! coordinate data for the given coordinate and stagger locations on the given local DE.
! This is useful, for example, for setting the coordinate values in a Grid, or
! for reading the coordinate values. Eventually this method will be overloaded
! for the full range of ESMF supported types and dimensions.
!
! The arguments are:
! \begin{description}
! \item[{grid}]
! Grid to get the information from.
! \item[{coordDim}]
! The coordinate dimension to get the data from (e.g. 1=x).
! \item[{staggerloc}]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! \item[{[localDE]}]
! The 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}]
! The pointer to the coordinate data.
! \item[{[datacopyflag]}]
! If not specified, default to {\tt ESMF\_DATACOPY\_REFERENCE}, in this case
! farrayPtr is a reference to the data in the Grid coordinate arrays.
! Please see Section~\ref{const:datacopyflag} for further description and a
! list of valid values.
! \item[{[exclusiveLBound]}]
! Upon return this holds the lower bounds of the exclusive region.
! {\tt exclusiveLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveUBound]}]
! Upon return this holds the upper bounds of the exclusive region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveCount]}]
! Upon return this holds the number of items in the exclusive region per dimension
! (i.e. {\tt exclusiveUBound-exclusiveLBound+1}). {\tt exclusiveCount} must
! be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalLBound]}]
! Upon return this holds the lower bounds of the stagger region.
! {\tt computationalLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalUBound]}]
! Upon return this holds the upper bounds of the stagger region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalCount]}]
! Upon return this holds the number of items in the computational region per dimension
! (i.e. {\tt computationalUBound-computationalLBound+1}). {\tt computationalCount}
! must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalLBound]}]
! Upon return this holds the lower bounds of the total region.
! {\tt totalLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalUBound]}]
! Upon return this holds the upper bounds of the total region.
! {\tt totalUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalCount]}]
! \begin{sloppypar}
! Upon return this holds the number of items in the total region per dimension
! (i.e. {\tt totalUBound-totalLBound+1}). {\tt totalCount} must
! be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
! Local variables
type(ESMF_Array) :: array
integer :: localrc ! local error status
integer :: dimCount
type(ESMF_TypeKind_Flag) :: typekind
type(ESMF_LocalArray) :: localarray
type(ESMF_DataCopy_Flag) :: datacopyflagInt
integer :: coordDimCount(ESMF_MAXDIM)
type(ESMF_InterArray) :: exclusiveLBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveUBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveCountArg ! helper variable
type(ESMF_InterArray) :: computationalLBoundArg ! helper variable
type(ESMF_InterArray) :: computationalUBoundArg ! helper variable
type(ESMF_InterArray) :: computationalCountArg ! helper variable
type(ESMF_InterArray) :: totalLBoundArg ! helper variable
type(ESMF_InterArray) :: totalUBoundArg ! helper variable
type(ESMF_InterArray) :: totalCountArg ! helper variable
integer :: tmp_staggerloc
type(ESMF_GridDecompType) :: decompType
! 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_GridGetInit, grid, rc)
call ESMF_GridGetDecompType(grid, decompType, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Check consistency
call ESMF_GridGet(grid, coordTypeKind=typekind, dimCount=dimCount, coordDimCount=coordDimCount, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Require farrayPtr typekind to match Grid typekind
if (typekind /= ESMF_TYPEKIND_R4) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- farrayPtr typekind does not match Grid typekind", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! make sure coord is legitimate
if ((coordDim .lt. 1) .or. (coordDim > dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- coordinate dimension outside of range specified for this Grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Require farrayPtr dimCount to match coordinate dimCount
if (coordDimCount(coordDim) /= 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- farrayPtr dimCount does not match requested coordinate dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Set Defaults
if (present(datacopyflag)) then
datacopyflagInt=datacopyflag
else
datacopyflagInt=ESMF_DATACOPY_REFERENCE
endif
!! localDE is error checked inside ESMF_ArrayGet() and GetCoordBounds(), so don't do it here !!
! handle staggerloc
if (present(staggerloc)) then
if ((decompType == ESMF_GRID_ARBITRARY) .and. &
(staggerloc /= ESMF_STAGGERLOC_CENTER)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- staggerloc has to be ESMF_STAGGERLOC_CENTER for arbitrary grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
else
tmp_staggerloc=staggerloc%staggerloc
endif
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc
endif
! Get the Array
call ESMF_GridGetCoordIntoArray(grid, coordDim, staggerloc, array, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get the pointer from the array
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=datacopyflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! process optional arguments
exclusiveLBoundArg=ESMF_InterArrayCreate(exclusiveLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveUBoundArg=ESMF_InterArrayCreate(exclusiveUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveCountArg=ESMF_InterArrayCreate(exclusiveCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalLBoundArg=ESMF_InterArrayCreate(computationalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalUBoundArg=ESMF_InterArrayCreate(computationalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalCountArg=ESMF_InterArrayCreate(computationalCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalLBoundArg=ESMF_InterArrayCreate(totalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalUBoundArg = ESMF_InterArrayCreate(totalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalCountArg = ESMF_InterArrayCreate(totalCount, 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_GridGetCoordBounds(grid, localDE, coordDim, tmp_staggerloc, &
exclusiveLBoundArg, exclusiveUBoundArg, exclusiveCountArg, &
computationalLBoundArg, computationalUBoundArg, computationalCountArg,&
totalLBoundArg, totalUBoundArg, totalCountArg, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate interface ints
call ESMF_InterArrayDestroy(exclusiveLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalCountArg, 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_GridGetCoord1DR4
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetCoord2DR4"
!BOPI
! !IROUTINE: ESMF_GridGetCoord - Get pointer to 2DR4 coordinates
! !INTERFACE:
! Private name; call using ESMF_GridGetCoord()
subroutine ESMF_GridGetCoord2DR4(grid, coordDim, keywordEnforcer, &
staggerloc, localDE, farrayPtr, datacopyflag, &
exclusiveLBound, exclusiveUBound, exclusiveCount, &
computationalLBound, computationalUBound, computationalCount, &
totalLBound, totalUBound, totalCount, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
integer, intent(in) :: coordDim
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type (ESMF_StaggerLoc), intent(in),optional :: staggerloc
integer, intent(in),optional :: localDE
real(ESMF_KIND_R4), pointer :: farrayPtr(:,:)
type(ESMF_DataCopy_Flag), intent(in),optional :: datacopyflag
integer, target, intent(out), optional :: exclusiveLBound(:)
integer, target, intent(out), optional :: exclusiveUBound(:)
integer, target, intent(out), optional :: exclusiveCount(:)
integer, target, intent(out), optional :: computationalLBound(:)
integer, target, intent(out), optional :: computationalUBound(:)
integer, target, intent(out), optional :: computationalCount(:)
integer, target, intent(out), optional :: totalLBound(:)
integer, target, intent(out), optional :: totalUBound(:)
integer, target, intent(out), optional :: totalCount(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This method gets a Fortran pointer to the piece of memory which holds the
! coordinate data for the given coordinate and stagger locations on the given local DE.
! This is useful, for example, for setting the coordinate values in a Grid, or
! for reading the coordinate values. Eventually this method will be overloaded
! for the full range of ESMF supported types and dimensions.
!
! The arguments are:
! \begin{description}
! \item[{grid}]
! Grid to get the information from.
! \item[{coordDim}]
! The coordinate dimension to get the data from (e.g. 1=x).
! \item[{staggerloc}]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
! \item[{[localDE]}]
! The 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}]
! The pointer to the coordinate data.
! \item[{[datacopyflag]}]
! If not specified, default to {\tt ESMF\_DATACOPY\_REFERENCE}, in this case
! farrayPtr is a reference to the data in the Grid coordinate arrays.
! Please see Section~\ref{const:datacopyflag} for further description and a
! list of valid values.
! \item[{[exclusiveLBound]}]
! Upon return this holds the lower bounds of the exclusive region.
! {\tt exclusiveLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveUBound]}]
! Upon return this holds the upper bounds of the exclusive region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveCount]}]
! Upon return this holds the number of items in the exclusive region per dimension
! (i.e. {\tt exclusiveUBound-exclusiveLBound+1}). {\tt exclusiveCount} must
! be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalLBound]}]
! Upon return this holds the lower bounds of the stagger region.
! {\tt computationalLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalUBound]}]
! Upon return this holds the upper bounds of the stagger region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalCount]}]
! Upon return this holds the number of items in the computational region per dimension
! (i.e. {\tt computationalUBound-computationalLBound+1}). {\tt computationalCount}
! must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalLBound]}]
! Upon return this holds the lower bounds of the total region.
! {\tt totalLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalUBound]}]
! Upon return this holds the upper bounds of the total region.
! {\tt totalUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalCount]}]
! Upon return this holds the number of items in the total region per dimension
! (i.e. {\tt totalUBound-totalLBound+1}). {\tt totalCount} must
! be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
! Local variables
type(ESMF_Array) :: array
integer :: localrc ! local error status
integer :: dimCount
type(ESMF_TypeKind_Flag) :: typekind
type(ESMF_LocalArray) :: localarray
type(ESMF_DataCopy_Flag) :: datacopyflagInt
integer :: coordDimCount(ESMF_MAXDIM)
type(ESMF_InterArray) :: exclusiveLBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveUBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveCountArg ! helper variable
type(ESMF_InterArray) :: computationalLBoundArg ! helper variable
type(ESMF_InterArray) :: computationalUBoundArg ! helper variable
type(ESMF_InterArray) :: computationalCountArg ! helper variable
type(ESMF_InterArray) :: totalLBoundArg ! helper variable
type(ESMF_InterArray) :: totalUBoundArg ! helper variable
type(ESMF_InterArray) :: totalCountArg ! helper variable
integer :: tmp_staggerloc
type(ESMF_GridDecompType) :: decompType
! 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_GridGetInit, grid, rc)
call ESMF_GridGetDecompType(grid, decompType, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Check consistency
call ESMF_GridGet(grid, coordTypeKind=typekind, dimCount=dimCount, coordDimCount=coordDimCount, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Require farrayPtr typekind to match Grid typekind
if (typekind /= ESMF_TYPEKIND_R4) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- farrayPtr typekind does not match Grid typekind", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! make sure coord is legitimate
if ((coordDim .lt. 1) .or. (coordDim > dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- coordinate dimension outside of range specified for this Grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Require farrayPtr dimCount to match coordinate dimCount
if (coordDimCount(coordDim) /= 2) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- farrayPtr dimCount does not match requested coordinate dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Set Defaults
if (present(datacopyflag)) then
datacopyflagInt=datacopyflag
else
datacopyflagInt=ESMF_DATACOPY_REFERENCE
endif
!! localDE is error checked inside ESMF_ArrayGet(), so don't do it here !!
! handle staggerloc
if (present(staggerloc)) then
if ((decompType == ESMF_GRID_ARBITRARY) .and. &
(staggerloc /= ESMF_STAGGERLOC_CENTER)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- staggerloc has to be ESMF_STAGGERLOC_CENTER for arbitrary grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
else
tmp_staggerloc=staggerloc%staggerloc
endif
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc
endif
! Get the Array
call ESMF_GridGetCoordIntoArray(grid, coordDim, staggerloc, array, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
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=datacopyflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! process optional arguments
exclusiveLBoundArg=ESMF_InterArrayCreate(exclusiveLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveUBoundArg=ESMF_InterArrayCreate(exclusiveUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveCountArg=ESMF_InterArrayCreate(exclusiveCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalLBoundArg=ESMF_InterArrayCreate(computationalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalUBoundArg=ESMF_InterArrayCreate(computationalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalCountArg=ESMF_InterArrayCreate(computationalCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalLBoundArg=ESMF_InterArrayCreate(totalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalUBoundArg = ESMF_InterArrayCreate(totalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalCountArg = ESMF_InterArrayCreate(totalCount, 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_GridGetCoordBounds(grid, localDE, coordDim, tmp_staggerloc, &
exclusiveLBoundArg, exclusiveUBoundArg, exclusiveCountArg, &
computationalLBoundArg, computationalUBoundArg, computationalCountArg,&
totalLBoundArg, totalUBoundArg, totalCountArg, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate interface ints
call ESMF_InterArrayDestroy(exclusiveLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalCountArg, 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_GridGetCoord2DR4
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetCoord3DR4"
!BOPI
! !IROUTINE: ESMF_GridGetCoord - Get pointer to 3DR4 coordinates
! !INTERFACE:
! Private name; call using ESMF_GridGetCoord()
subroutine ESMF_GridGetCoord3DR4(grid, coordDim, keywordEnforcer, &
staggerloc, localDE, farrayPtr, datacopyflag, &
exclusiveLBound, exclusiveUBound, exclusiveCount, &
computationalLBound, computationalUBound, computationalCount, &
totalLBound, totalUBound, totalCount, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
integer, intent(in) :: coordDim
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
integer, intent(in),optional :: localDE
real(ESMF_KIND_R4), pointer :: farrayPtr(:,:,:)
type(ESMF_DataCopy_Flag), intent(in),optional :: datacopyflag
integer, target, intent(out), optional :: exclusiveLBound(:)
integer, target, intent(out), optional :: exclusiveUBound(:)
integer, target, intent(out), optional :: exclusiveCount(:)
integer, target, intent(out), optional :: computationalLBound(:)
integer, target, intent(out), optional :: computationalUBound(:)
integer, target, intent(out), optional :: computationalCount(:)
integer, target, intent(out), optional :: totalLBound(:)
integer, target, intent(out), optional :: totalUBound(:)
integer, target, intent(out), optional :: totalCount(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This method gets a Fortran pointer to the piece of memory which holds the
! coordinate data for the given coordinate and stagger locations on the given local DE.
! This is useful, for example, for setting the coordinate values in a Grid, or
! for reading the coordinate values. Eventually this method will be overloaded
! for the full range of ESMF supported types and dimensions.
!
! The arguments are:
! \begin{description}
! \item[{grid}]
! Grid to get the information from.
! \item[{coordDim}]
! The coordinate dimension to get the data from (e.g. 1=x).
! \item[{staggerloc}]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
! \item[{[localDE]}]
! The 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}]
! The pointer to the coordinate data.
! \item[{[datacopyflag]}]
! If not specified, default to {\tt ESMF\_DATACOPY\_REFERENCE}, in this case
! farrayPtr is a reference to the data in the Grid coordinate arrays.
! Please see Section~\ref{const:datacopyflag} for further description and a
! list of valid values.
! \item[{[exclusiveLBound]}]
! Upon return this holds the lower bounds of the exclusive region.
! {\tt exclusiveLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveUBound]}]
! Upon return this holds the upper bounds of the exclusive region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveCount]}]
! Upon return this holds the number of items in the exclusive region per dimension
! (i.e. {\tt exclusiveUBound-exclusiveLBound+1}). {\tt exclusiveCount} must
! be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalLBound]}]
! Upon return this holds the lower bounds of the stagger region.
! {\tt computationalLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalUBound]}]
! Upon return this holds the upper bounds of the stagger region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalCount]}]
! Upon return this holds the number of items in the computational region per dimension
! (i.e. {\tt computationalUBound-computationalLBound+1}). {\tt computationalCount}
! must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalLBound]}]
! Upon return this holds the lower bounds of the total region.
! {\tt totalLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalUBound]}]
! Upon return this holds the upper bounds of the total region.
! {\tt totalUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalCount]}]
! Upon return this holds the number of items in the total region per dimension
! (i.e. {\tt totalUBound-totalLBound+1}). {\tt totalCount} must
! be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
! Local variables
type(ESMF_Array) :: array
integer :: localrc ! local error status
integer :: dimCount
type(ESMF_TypeKind_Flag) :: typekind
type(ESMF_LocalArray) :: localArray
type(ESMF_DataCopy_Flag) :: datacopyflagInt
integer :: coordDimCount(ESMF_MAXDIM)
type(ESMF_InterArray) :: exclusiveLBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveUBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveCountArg ! helper variable
type(ESMF_InterArray) :: computationalLBoundArg ! helper variable
type(ESMF_InterArray) :: computationalUBoundArg ! helper variable
type(ESMF_InterArray) :: computationalCountArg ! helper variable
type(ESMF_InterArray) :: totalLBoundArg ! helper variable
type(ESMF_InterArray) :: totalUBoundArg ! helper variable
type(ESMF_InterArray) :: totalCountArg ! helper variable
integer :: tmp_staggerloc
type(ESMF_GridDecompType) :: decompType
! 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_GridGetInit, grid, rc)
call ESMF_GridGetDecompType(grid, decompType, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Check consistency
call ESMF_GridGet(grid, coordTypeKind=typekind, dimCount=dimCount, coordDimCount=coordDimCount, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Require farrayPtr typekind to match Grid typekind
if (typekind /= ESMF_TYPEKIND_R4) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- farrayPtr typekind does not match Grid typekind", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! make sure coord is legitimate
if ((coordDim .lt. 1) .or. (coordDim > dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- coordinate dimension outside of range specified for this Grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Require farrayPtr dimCount to match coordinate dimCount
if (coordDimCount(coordDim) /= 3) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- farrayPtr dimCount does not match requested coordinate dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Set Defaults
if (present(datacopyflag)) then
datacopyflagInt=datacopyflag
else
datacopyflagInt=ESMF_DATACOPY_REFERENCE
endif
!! localDE is error checked inside ESMF_ArrayGet() and GetCoordBounds(), so don't do it here !!
! handle staggerloc
if (present(staggerloc)) then
if ((decompType == ESMF_GRID_ARBITRARY) .and. &
(staggerloc /= ESMF_STAGGERLOC_CENTER)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- staggerloc has to be ESMF_STAGGERLOC_CENTER for arbitrary grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
else
tmp_staggerloc=staggerloc%staggerloc
endif
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc
endif
! Get the Array
call ESMF_GridGetCoordIntoArray(grid, coordDim, staggerloc, array, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
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=datacopyflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! process optional arguments
! for non-arbitrarily grid only
! should check these optional arguments are not present for arbitrary grid????
if (decompType /= ESMF_GRID_ARBITRARY) then
exclusiveLBoundArg=ESMF_InterArrayCreate(exclusiveLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveUBoundArg=ESMF_InterArrayCreate(exclusiveUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveCountArg=ESMF_InterArrayCreate(exclusiveCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalLBoundArg=ESMF_InterArrayCreate(computationalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalUBoundArg=ESMF_InterArrayCreate(computationalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalCountArg=ESMF_InterArrayCreate(computationalCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalLBoundArg=ESMF_InterArrayCreate(totalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalUBoundArg = ESMF_InterArrayCreate(totalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalCountArg = ESMF_InterArrayCreate(totalCount, 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_GridGetCoordBounds(grid, localDE, coordDim, tmp_staggerloc, &
exclusiveLBoundArg, exclusiveUBoundArg, exclusiveCountArg, &
computationalLBoundArg, computationalUBoundArg, computationalCountArg,&
totalLBoundArg, totalUBoundArg, totalCountArg, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate interface ints
call ESMF_InterArrayDestroy(exclusiveLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalCountArg, 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_GridGetCoord3DR4
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetCoord1DR8"
!BOPI
! !IROUTINE: ESMF_GridGetCoord - Get pointer to 1DR8 coordinates
! !INTERFACE:
! Private name; call using ESMF_GridGetCoord()
subroutine ESMF_GridGetCoord1DR8(grid, coordDim, keywordEnforcer, &
staggerloc, localDE, farrayPtr, datacopyflag, &
exclusiveLBound, exclusiveUBound, exclusiveCount, &
computationalLBound, computationalUBound, computationalCount, &
totalLBound, totalUBound, totalCount, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
integer, intent(in) :: coordDim
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type (ESMF_StaggerLoc), intent(in),optional :: staggerloc
integer, intent(in),optional :: localDE
real(ESMF_KIND_R8), pointer :: farrayPtr(:)
type(ESMF_DataCopy_Flag), intent(in),optional :: datacopyflag
integer, target, intent(out), optional :: exclusiveLBound(:)
integer, target, intent(out), optional :: exclusiveUBound(:)
integer, target, intent(out), optional :: exclusiveCount(:)
integer, target, intent(out), optional :: computationalLBound(:)
integer, target, intent(out), optional :: computationalUBound(:)
integer, target, intent(out), optional :: computationalCount(:)
integer, target, intent(out), optional :: totalLBound(:)
integer, target, intent(out), optional :: totalUBound(:)
integer, target, intent(out), optional :: totalCount(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This method gets a Fortran pointer to the piece of memory which holds the
! coordinate data for the given coordinate and stagger locations on the given local DE.
! This is useful, for example, for setting the coordinate values in a Grid, or
! for reading the coordinate values. Eventually this method will be overloaded
! for the full range of ESMF supported types and dimensions.
!
! The arguments are:
! \begin{description}
! \item[{grid}]
! Grid to get the information from.
! \item[{coordDim}]
! The coordinate dimension to get the data from (e.g. 1=x).
! \item[{staggerloc}]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
! \item[{[localDE]}]
! The 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}]
! The pointer to the coordinate data.
! \item[{[datacopyflag]}]
! If not specified, default to {\tt ESMF\_DATACOPY\_REFERENCE}, in this case
! farrayPtr is a reference to the data in the Grid coordinate arrays.
! Please see Section~\ref{const:datacopyflag} for further description and a
! list of valid values.
! \item[{[exclusiveLBound]}]
! Upon return this holds the lower bounds of the exclusive region.
! {\tt exclusiveLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveUBound]}]
! Upon return this holds the upper bounds of the exclusive region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveCount]}]
! Upon return this holds the number of items in the exclusive region per dimension
! (i.e. {\tt exclusiveUBound-exclusiveLBound+1}). {\tt exclusiveCount} must
! be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalLBound]}]
! Upon return this holds the lower bounds of the stagger region.
! {\tt computationalLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalUBound]}]
! Upon return this holds the upper bounds of the stagger region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalCount]}]
! Upon return this holds the number of items in the computational region per dimension
! (i.e. {\tt computationalUBound-computationalLBound+1}). {\tt computationalCount}
! must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalLBound]}]
! Upon return this holds the lower bounds of the total region.
! {\tt totalLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalUBound]}]
! Upon return this holds the upper bounds of the total region.
! {\tt totalUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalCount]}]
! Upon return this holds the number of items in the total region per dimension
! (i.e. {\tt totalUBound-totalLBound+1}). {\tt totalCount} must
! be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
! Local variables
type(ESMF_Array) :: array
integer :: localrc ! local error status
integer :: dimCount
type(ESMF_TypeKind_Flag) :: typekind
type(ESMF_LocalArray) :: localArray
type(ESMF_DataCopy_Flag) :: datacopyflagInt
integer :: coordDimCount(ESMF_MAXDIM)
type(ESMF_InterArray) :: exclusiveLBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveUBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveCountArg ! helper variable
type(ESMF_InterArray) :: computationalLBoundArg ! helper variable
type(ESMF_InterArray) :: computationalUBoundArg ! helper variable
type(ESMF_InterArray) :: computationalCountArg ! helper variable
type(ESMF_InterArray) :: totalLBoundArg ! helper variable
type(ESMF_InterArray) :: totalUBoundArg ! helper variable
type(ESMF_InterArray) :: totalCountArg ! helper variable
integer :: tmp_staggerloc
type(ESMF_GridDecompType) :: decompType
! 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_GridGetInit, grid, rc)
call ESMF_GridGetDecompType(grid, decompType, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Check consistency
call ESMF_GridGet(grid, coordTypeKind=typekind, dimCount=dimCount, coordDimCount=coordDimCount, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Require farrayPtr typekind to match Grid typekind
if (typekind /= ESMF_TYPEKIND_R8) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- farrayPtr typekind does not match Grid typekind", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! make sure coord is legitimate
if ((coordDim .lt. 1) .or. (coordDim > dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- coordinate dimension outside of range specified for this Grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Require farrayPtr dimCount to match coordinate dimCount
if (coordDimCount(coordDim) /= 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- farrayPtr dimCount does not match requested coordinate dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Set Defaults
if (present(datacopyflag)) then
datacopyflagInt=datacopyflag
else
datacopyflagInt=ESMF_DATACOPY_REFERENCE
endif
!! localDE is error checked inside ESMF_ArrayGet() and GetCoordBounds(), so don't do it here !!
! handle staggerloc
if (present(staggerloc)) then
if ((decompType == ESMF_GRID_ARBITRARY) .and. &
(staggerloc /= ESMF_STAGGERLOC_CENTER)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- staggerloc has to be ESMF_STAGGERLOC_CENTER for arbitrary grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
else
tmp_staggerloc=staggerloc%staggerloc
endif
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc
endif
! Get the Array
call ESMF_GridGetCoordIntoArray(grid, coordDim, staggerloc, array, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
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=datacopyflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! process optional arguments
exclusiveLBoundArg=ESMF_InterArrayCreate(exclusiveLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveUBoundArg=ESMF_InterArrayCreate(exclusiveUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveCountArg=ESMF_InterArrayCreate(exclusiveCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalLBoundArg=ESMF_InterArrayCreate(computationalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalUBoundArg=ESMF_InterArrayCreate(computationalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalCountArg=ESMF_InterArrayCreate(computationalCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalLBoundArg=ESMF_InterArrayCreate(totalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalUBoundArg = ESMF_InterArrayCreate(totalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalCountArg = ESMF_InterArrayCreate(totalCount, 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_GridGetCoordBounds(grid, localDE, coordDim, tmp_staggerloc, &
exclusiveLBoundArg, exclusiveUBoundArg, exclusiveCountArg, &
computationalLBoundArg, computationalUBoundArg, computationalCountArg,&
totalLBoundArg, totalUBoundArg, totalCountArg, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate interface ints
call ESMF_InterArrayDestroy(exclusiveLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalCountArg, 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_GridGetCoord1DR8
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetCoord2DR8"
!BOPI
! !IROUTINE: ESMF_GridGetCoord - Get pointer to 2DR8 coordinates
! !INTERFACE:
! Private name; call using ESMF_GridGetCoord()
subroutine ESMF_GridGetCoord2DR8(grid, coordDim, keywordEnforcer, &
staggerloc, localDE, farrayPtr, datacopyflag, &
exclusiveLBound, exclusiveUBound, exclusiveCount, &
computationalLBound, computationalUBound, computationalCount, &
totalLBound, totalUBound, totalCount, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
integer, intent(in) :: coordDim
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type (ESMF_StaggerLoc), intent(in),optional :: staggerloc
integer, intent(in),optional :: localDE
real(ESMF_KIND_R8), pointer :: farrayPtr(:,:)
type(ESMF_DataCopy_Flag), intent(in),optional :: datacopyflag
integer, target, intent(out), optional :: exclusiveLBound(:)
integer, target, intent(out), optional :: exclusiveUBound(:)
integer, target, intent(out), optional :: exclusiveCount(:)
integer, target, intent(out), optional :: computationalLBound(:)
integer, target, intent(out), optional :: computationalUBound(:)
integer, target, intent(out), optional :: computationalCount(:)
integer, target, intent(out), optional :: totalLBound(:)
integer, target, intent(out), optional :: totalUBound(:)
integer, target, intent(out), optional :: totalCount(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This method gets a Fortran pointer to the piece of memory which holds the
! coordinate data for the given coordinate and stagger locations on the given local DE.
! This is useful, for example, for setting the coordinate values in a Grid, or
! for reading the coordinate values. Eventually this method will be overloaded
! for the full range of ESMF supported types and dimensions.
!
! The arguments are:
! \begin{description}
! \item[{grid}]
! Grid to get the information from.
! \item[{coordDim}]
! The coordinate dimension to get the data from (e.g. 1=x).
! \item[{staggerloc}]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
! \item[{[localDE]}]
! The 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}]
! The pointer to the coordinate data.
! \item[{[datacopyflag]}]
! If not specified, default to {\tt ESMF\_DATACOPY\_REFERENCE}, in this case
! farrayPtr is a reference to the data in the Grid coordinate arrays.
! Please see Section~\ref{const:datacopyflag} for further description and a
! list of valid values.
! \item[{[exclusiveLBound]}]
! Upon return this holds the lower bounds of the exclusive region.
! {\tt exclusiveLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveUBound]}]
! Upon return this holds the upper bounds of the exclusive region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveCount]}]
! Upon return this holds the number of items in the exclusive region per dimension
! (i.e. {\tt exclusiveUBound-exclusiveLBound+1}). {\tt exclusiveCount} must
! be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalLBound]}]
! Upon return this holds the lower bounds of the stagger region.
! {\tt computationalLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalUBound]}]
! Upon return this holds the upper bounds of the stagger region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalCount]}]
! Upon return this holds the number of items in the computational region per dimension
! (i.e. {\tt computationalUBound-computationalLBound+1}). {\tt computationalCount}
! must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalLBound]}]
! Upon return this holds the lower bounds of the total region.
! {\tt totalLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalUBound]}]
! Upon return this holds the upper bounds of the total region.
! {\tt totalUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalCount]}]
! Upon return this holds the number of items in the total region per dimension
! (i.e. {\tt totalUBound-totalLBound+1}). {\tt totalCount} must
! be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
! Local variables
type(ESMF_Array) :: array
integer :: localrc ! local error status
integer :: dimCount
type(ESMF_TypeKind_Flag) :: typekind
type(ESMF_LocalArray) :: localarray
type(ESMF_DataCopy_Flag) :: datacopyflagInt
integer :: coordDimCount(ESMF_MAXDIM)
type(ESMF_InterArray) :: exclusiveLBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveUBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveCountArg ! helper variable
type(ESMF_InterArray) :: computationalLBoundArg ! helper variable
type(ESMF_InterArray) :: computationalUBoundArg ! helper variable
type(ESMF_InterArray) :: computationalCountArg ! helper variable
type(ESMF_InterArray) :: totalLBoundArg ! helper variable
type(ESMF_InterArray) :: totalUBoundArg ! helper variable
type(ESMF_InterArray) :: totalCountArg ! helper variable
integer :: tmp_staggerloc
type(ESMF_GridDecompType) :: decompType
! 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_GridGetInit, grid, rc)
call ESMF_GridGetDecompType(grid, decompType, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Check consistency
call ESMF_GridGet(grid, coordTypeKind=typekind, dimCount=dimCount, coordDimCount=coordDimCount, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Require farrayPtr typekind to match Grid typekind
if (typekind /= ESMF_TYPEKIND_R8) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- farrayPtr typekind does not match Grid typekind", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! make sure coord is legitimate
if ((coordDim .lt. 1) .or. (coordDim > dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- coordinate dimension outside of range specified for this Grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Require farrayPtr dimCount to match coordinate dimCount
if (coordDimCount(coordDim) /= 2) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- farrayPtr dimCount does not match requested coordinate dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Set Defaults
if (present(datacopyflag)) then
datacopyflagInt=datacopyflag
else
datacopyflagInt=ESMF_DATACOPY_REFERENCE
endif
!! localDE is error checked inside ESMF_ArrayGet() and GetCoordBounds(), so don't do it here !!
! handle staggerloc
if (present(staggerloc)) then
if ((decompType == ESMF_GRID_ARBITRARY) .and. &
(staggerloc /= ESMF_STAGGERLOC_CENTER)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- staggerloc has to be ESMF_STAGGERLOC_CENTER for arbitrary grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
else
tmp_staggerloc=staggerloc%staggerloc
endif
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc
endif
! Get the Array
call ESMF_GridGetCoordIntoArray(grid, coordDim, staggerloc, array, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
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=datacopyflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! process optional arguments
exclusiveLBoundArg=ESMF_InterArrayCreate(exclusiveLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveUBoundArg=ESMF_InterArrayCreate(exclusiveUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveCountArg=ESMF_InterArrayCreate(exclusiveCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalLBoundArg=ESMF_InterArrayCreate(computationalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalUBoundArg=ESMF_InterArrayCreate(computationalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalCountArg=ESMF_InterArrayCreate(computationalCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalLBoundArg=ESMF_InterArrayCreate(totalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalUBoundArg = ESMF_InterArrayCreate(totalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalCountArg = ESMF_InterArrayCreate(totalCount, 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_GridGetCoordBounds(grid, localDE, coordDim, tmp_staggerloc, &
exclusiveLBoundArg, exclusiveUBoundArg, exclusiveCountArg, &
computationalLBoundArg, computationalUBoundArg, computationalCountArg,&
totalLBoundArg, totalUBoundArg, totalCountArg, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate interface ints
call ESMF_InterArrayDestroy(exclusiveLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalCountArg, 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_GridGetCoord2DR8
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetCoord3DR8"
!BOPI
! !IROUTINE: ESMF_GridGetCoord - Get pointer to 3DR8 coordinates
! !INTERFACE:
! Private name; call using ESMF_GridGetCoord()
subroutine ESMF_GridGetCoord3DR8(grid, coordDim, keywordEnforcer, &
staggerloc, localDE, farrayPtr, datacopyflag, &
exclusiveLBound, exclusiveUBound, exclusiveCount, &
computationalLBound, computationalUBound, computationalCount, &
totalLBound, totalUBound, totalCount, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
integer, intent(in) :: coordDim
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type (ESMF_StaggerLoc), intent(in),optional :: staggerloc
integer, intent(in),optional :: localDE
real(ESMF_KIND_R8), pointer :: farrayPtr(:,:,:)
type(ESMF_DataCopy_Flag), intent(in),optional :: datacopyflag
integer, target, intent(out), optional :: exclusiveLBound(:)
integer, target, intent(out), optional :: exclusiveUBound(:)
integer, target, intent(out), optional :: exclusiveCount(:)
integer, target, intent(out), optional :: computationalLBound(:)
integer, target, intent(out), optional :: computationalUBound(:)
integer, target, intent(out), optional :: computationalCount(:)
integer, target, intent(out), optional :: totalLBound(:)
integer, target, intent(out), optional :: totalUBound(:)
integer, target, intent(out), optional :: totalCount(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This method gets a Fortran pointer to the piece of memory which holds the
! coordinate data for the given coordinate and stagger locations on the given local DE.
! This is useful, for example, for setting the coordinate values in a Grid, or
! for reading the coordinate values. Eventually this method will be overloaded
! for the full range of ESMF supported types and dimensions.
!
! The arguments are:
! \begin{description}
! \item[{grid}]
! Grid to get the information from.
! \item[{coordDim}]
! The coordinate dimension to get the data from (e.g. 1=x).
! \item[{staggerloc}]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
! \item[{[localDE]}]
! The 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}]
! The pointer to the coordinate data.
! \item[{[datacopyflag]}]
! If not specified, default to {\tt ESMF\_DATACOPY\_REFERENCE}, in this case
! farrayPtr is a reference to the data in the Grid coordinate arrays.
! Please see Section~\ref{const:datacopyflag} for further description and a
! list of valid values.
! \item[{[exclusiveLBound]}]
! Upon return this holds the lower bounds of the exclusive region.
! {\tt exclusiveLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveUBound]}]
! Upon return this holds the upper bounds of the exclusive region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveCount]}]
! Upon return this holds the number of items in the exclusive region per dimension
! (i.e. {\tt exclusiveUBound-exclusiveLBound+1}). {\tt exclusiveCount} must
! be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalLBound]}]
! Upon return this holds the lower bounds of the stagger region.
! {\tt computationalLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalUBound]}]
! Upon return this holds the upper bounds of the stagger region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalCount]}]
! Upon return this holds the number of items in the computational region per dimension
! (i.e. {\tt computationalUBound-computationalLBound+1}). {\tt computationalCount}
! must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalLBound]}]
! Upon return this holds the lower bounds of the total region.
! {\tt totalLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalUBound]}]
! Upon return this holds the upper bounds of the total region.
! {\tt totalUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalCount]}]
! Upon return this holds the number of items in the total region per dimension
! (i.e. {\tt totalUBound-totalLBound+1}). {\tt totalCount} must
! be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
! Local variables
type(ESMF_Array) :: array
integer :: localrc ! local error status
integer :: dimCount
type(ESMF_TypeKind_Flag) :: typekind
type(ESMF_LocalArray) :: localarray
type(ESMF_DataCopy_Flag) :: datacopyflagInt
integer :: coordDimCount(ESMF_MAXDIM)
type(ESMF_InterArray) :: exclusiveLBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveUBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveCountArg ! helper variable
type(ESMF_InterArray) :: computationalLBoundArg ! helper variable
type(ESMF_InterArray) :: computationalUBoundArg ! helper variable
type(ESMF_InterArray) :: computationalCountArg ! helper variable
type(ESMF_InterArray) :: totalLBoundArg ! helper variable
type(ESMF_InterArray) :: totalUBoundArg ! helper variable
type(ESMF_InterArray) :: totalCountArg ! helper variable
integer :: tmp_staggerloc
type(ESMF_GridDecompType) :: decompType
! 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_GridGetInit, grid, rc)
call ESMF_GridGetDecompType(grid, decompType, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Check consistency
call ESMF_GridGet(grid, coordTypeKind=typekind, dimCount=dimCount, coordDimCount=coordDimCount, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Require farrayPtr typekind to match Grid typekind
if (typekind /= ESMF_TYPEKIND_R8) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- farrayPtr typekind does not match Grid typekind", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! make sure coord is legitimate
if ((coordDim .lt. 1) .or. (coordDim > dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- coordinate dimension outside of range specified for this Grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Require farrayPtr dimCount to match coordinate dimCount
if (coordDimCount(coordDim) /= 3) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- farrayPtr dimCount does not match requested coordinate dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Set Defaults
if (present(datacopyflag)) then
datacopyflagInt=datacopyflag
else
datacopyflagInt=ESMF_DATACOPY_REFERENCE
endif
!! localDE is error checked inside ESMF_ArrayGet() and GetCoordBounds(), so don't do it here !!
! handle staggerloc
if (present(staggerloc)) then
if ((decompType == ESMF_GRID_ARBITRARY) .and. &
(staggerloc /= ESMF_STAGGERLOC_CENTER)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- staggerloc has to be ESMF_STAGGERLOC_CENTER for arbitrary grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
else
tmp_staggerloc=staggerloc%staggerloc
endif
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc
endif
! Get the Array
call ESMF_GridGetCoordIntoArray(grid, coordDim, staggerloc, array, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
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=datacopyflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! process optional arguments
exclusiveLBoundArg=ESMF_InterArrayCreate(exclusiveLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveUBoundArg=ESMF_InterArrayCreate(exclusiveUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveCountArg=ESMF_InterArrayCreate(exclusiveCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalLBoundArg=ESMF_InterArrayCreate(computationalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalUBoundArg=ESMF_InterArrayCreate(computationalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalCountArg=ESMF_InterArrayCreate(computationalCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalLBoundArg=ESMF_InterArrayCreate(totalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalUBoundArg = ESMF_InterArrayCreate(totalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalCountArg = ESMF_InterArrayCreate(totalCount, 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_GridGetCoordBounds(grid, localDE, coordDim, tmp_staggerloc, &
exclusiveLBoundArg, exclusiveUBoundArg, exclusiveCountArg, &
computationalLBoundArg, computationalUBoundArg, computationalCountArg,&
totalLBoundArg, totalUBoundArg, totalCountArg, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate interface ints
call ESMF_InterArrayDestroy(exclusiveLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalCountArg, 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_GridGetCoord3DR8
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetCoordIntoArray"
!BOP
!\label{API:GridGetCoordIntoArray}
! !IROUTINE: ESMF_GridGetCoord - Get coordinates and put into an Array
! !INTERFACE:
! Private name; call using ESMF_GridGetCoord()
subroutine ESMF_GridGetCoordIntoArray(grid, coordDim, staggerloc, &
array, keywordEnforcer, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
integer, intent(in) :: coordDim
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
type(ESMF_Array), intent(out) :: array
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \end{itemize}
!
! !DESCRIPTION:
! This method allows the user to get access to the ESMF Array holding
! coordinate data at a particular stagger location. This is useful, for example,
! to set the coordinate values. To have an Array to access, the coordinate Arrays
! must have already been allocated, for example by {\tt ESMF\_GridAddCoord} or
! {\tt ESMF\_GridSetCoord}.
!
! The arguments are:
! \begin{description}
! \item[grid]
! The grid to get the coord array from.
! \item[coordDim]
! The coordinate dimension to get the data from (e.g. 1=x).
! \item[{[staggerloc]}]
! The stagger location from which to get the arrays.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! \item[array]
! An array into which to put the coordinate information.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
integer :: tmp_staggerloc
integer :: localrc ! local error status
type(ESMF_GridDecompType) :: decompType
type(ESMF_DataCopy_Flag) :: datacopyflag
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check init status of arguments
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, grid, rc)
call ESMF_GridGetDecompType(grid, decompType, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! handle staggerloc
if (present(staggerloc)) then
if ((decompType == ESMF_GRID_ARBITRARY) .and. &
(staggerloc /= ESMF_STAGGERLOC_CENTER)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- staggerloc has to be ESMF_STAGGERLOC_CENTER for arbitrary grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
else
tmp_staggerloc=staggerloc%staggerloc
endif
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc
endif
! Init datacopyflag
datacopyflag=ESMF_DATACOPY_REFERENCE
! Call C++ Subroutine to do the create
call c_ESMC_gridgetcoordintoarray(grid%this,tmp_staggerloc, coordDim, &
array, datacopyflag, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set Array as created
call ESMF_ArraySetInitCreated(array,localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridGetCoordIntoArray
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetCoordR4"
!BOP
!\label{API:GridGetCoordR4}
! !IROUTINE: ESMF_GridGetCoord - Get DE-local coordinates from a specific index location in a Grid
! !INTERFACE:
! Private name; call using ESMF_GridGetCoord()
subroutine ESMF_GridGetCoordR4(grid, staggerloc, localDE, &
index, coord, keywordEnforcer, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
integer, intent(in), optional :: localDE
integer, intent(in) :: index(:)
real(ESMF_KIND_R4), intent(out) :: coord(:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \end{itemize}
!
! !DESCRIPTION:
! Given a specific index location in a Grid, this method returns the full set
! of coordinates from that index location. This method should work no matter what
! the factorization of the Grid's coordinate components.
!
! The arguments are:
! \begin{description}
! \item[grid]
! Grid to get the information from.
! \item[{[staggerloc]}]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
! \item[{[localDE]}]
! The 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[index]
! This array holds the index location to be queried in the Grid. This array must
! at least be of the size Grid rank.
! \item[coord]
! This array will be filled with the coordinate data. This array must
! at least be of the size Grid rank.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
! Local variables
integer :: localrc
integer :: tmp_staggerloc
! 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_GridGetInit, grid, rc)
! Have default option for staggerloc
if (present(staggerloc)) then
tmp_staggerloc=staggerloc%staggerloc
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc ! default
endif
! NOTE THERE IS NO INPUT VALUE CHECKING HERE BECAUSE IT'S DONE IN
! THE C++ VERSION.
! Call into the C++ interface
call c_esmc_gridgetcoordr4(grid, localDE, tmp_staggerloc, &
index, coord, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridGetCoordR4
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetCoordR8"
!BOP
!\label{API:GridGetCoordR8}
! !IROUTINE: ESMF_GridGetCoord - Get DE-local coordinates from a specific index location in a Grid
! !INTERFACE:
! Private name; call using ESMF_GridGetCoord()
subroutine ESMF_GridGetCoordR8(grid, staggerloc, localDE, &
index, coord, keywordEnforcer, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
integer, intent(in), optional :: localDE
integer, intent(in) :: index(:)
real(ESMF_KIND_R8), intent(out) :: coord(:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \end{itemize}
!
! !DESCRIPTION:
! Given a specific index location in a Grid, this method returns the full set
! of coordinates from that index location. This method should work no matter what
! the factorization of the Grid's coordinate components.
!
! The arguments are:
! \begin{description}
! \item[grid]
! Grid to get the information from.
! \item[{[staggerloc]}]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
! \item[{[localDE]}]
! The 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[index]
! This array holds the index location to be queried in the Grid. This array must
! at least be of the size Grid rank.
! \item[coord]
! This array will be filled with the coordinate data. This array must
! at least be of the size Grid rank.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
! Local variables
integer :: localrc
integer :: tmp_staggerloc
! 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_GridGetInit, grid, rc)
! Have default option for staggerloc
if (present(staggerloc)) then
tmp_staggerloc=staggerloc%staggerloc
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc ! default
endif
! NOTE THERE IS NO INPUT VALUE CHECKING HERE BECAUSE IT'S DONE IN
! THE C++ VERSION.
! Call into the C++ interface
call c_esmc_gridgetcoordr8(grid, localDE, tmp_staggerloc, &
index, coord, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridGetCoordR8
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetCoordInfo"
!BOP
!\label{API:GridGetCoordInfo}
! !IROUTINE: ESMF_GridGetCoord - Get information about the coordinates at a particular stagger location
! !INTERFACE:
! Private name; call using ESMF_GridGetCoord()
subroutine ESMF_GridGetCoordInfo(grid, keywordEnforcer, &
staggerloc, isPresent, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
logical, intent(out), optional :: isPresent
integer, intent(out), optional :: rc
!
!
! !DESCRIPTION:
! This method allows the user to get information about the coordinates on a given
! stagger.
!
! The arguments are:
! \begin{description}
! \item[grid]
! Grid to get the information from.
! \item[{[staggerloc]}]
! The stagger location from which to get information.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! \item[{[isPresent]}]
! If .true. then coordinates have been added on this staggerloc.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
integer :: tmp_staggerloc
integer :: localrc ! local error status
integer :: isPresentInt
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check init status of arguments
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, grid, rc)
! handle staggerloc
if (present(staggerloc)) then
tmp_staggerloc=staggerloc%staggerloc
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc
endif
! XMRKX
! Call C++ Subroutine
if (present(isPresent)) then
isPresent=.false.
call c_ESMC_gridgetcoordpresent(grid%this,tmp_staggerloc, &
isPresentInt, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Interpret isPresentInt
if (isPresentInt==1) then
isPresent=.true.
else
isPresent=.false.
endif
endif
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridGetCoordInfo
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetCoordBounds"
!BOP
! !IROUTINE: ESMF_GridGetCoordBounds - Get Grid coordinate bounds
! !INTERFACE:
subroutine ESMF_GridGetCoordBounds(grid, coordDim, keywordEnforcer, &
staggerloc, localDE, exclusiveLBound, exclusiveUBound, &
exclusiveCount, computationalLBound, computationalUBound , &
computationalCount, totalLBound, totalUBound, totalCount, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
integer, intent(in) :: coordDim
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
integer, intent(in), optional :: localDE
integer, target, intent(out), optional :: exclusiveLBound(:)
integer, target, intent(out), optional :: exclusiveUBound(:)
integer, target, intent(out), optional :: exclusiveCount(:)
integer, target, intent(out), optional :: computationalLBound(:)
integer, target, intent(out), optional :: computationalUBound(:)
integer, target, intent(out), optional :: computationalCount(:)
integer, target, intent(out), optional :: totalLBound(:)
integer, target, intent(out), optional :: totalUBound(:)
integer, target, intent(out), optional :: totalCount(:)
integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \end{itemize}
!
! !DESCRIPTION:
! This method gets information about the range of index space which a particular
! piece of coordinate data occupies. In other words, this method returns the
! bounds of the coordinate arrays. Note that unlike the output from the
! Array, these values also include the undistributed dimensions and are
! ordered to reflect the order of the indices in the coordinate. So, for example,
! {\tt totalLBound} and {\tt totalUBound} should match the bounds of the Fortran array
! retrieved by {\tt ESMF\_GridGetCoord}.
!
!The arguments are:
!\begin{description}
!\item[grid]
! Grid to get the information from.
!\item[coordDim]
! The coordinate dimension to get the information for (e.g. 1=x).
!\item[{[staggerloc]}]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
!\item[{[localDE]}]
! The 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[{[exclusiveLBound]}]
! Upon return this holds the lower bounds of the exclusive region.
! {\tt exclusiveLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
!\item[{[exclusiveUBound]}]
! Upon return this holds the upper bounds of the exclusive region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
!\item[{[exclusiveCount]}]
! Upon return this holds the number of items, {\tt exclusiveUBound-exclusiveLBound+1},
! in the exclusive region per dimension.
! {\tt exclusiveCount} must
! be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
!\item[{[computationalLBound]}]
! Upon return this holds the lower bounds of the stagger region.
! {\tt computationalLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
!\item[{[computationalUBound]}]
! Upon return this holds the upper bounds of the stagger region.
! {\tt computationalUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
!\item[{[computationalCount]}]
! Upon return this holds the number of items in the computational region per dimension
! (i.e. {\tt computationalUBound-computationalLBound+1}). {\tt computationalCount}
! must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
!\item[{[totalLBound]}]
! Upon return this holds the lower bounds of the total region.
! {\tt totalLBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
!\item[{[totalUBound]}]
! Upon return this holds the upper bounds of the total region.
! {\tt totalUBound} must be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
!\item[{[totalCount]}]
! \begin{sloppypar}
! Upon return this holds the number of items in the total region per dimension
! (i.e. {\tt totalUBound-totalLBound+1}). {\tt totalCount} must
! be allocated to be of size equal to the coord dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \end{sloppypar}
!\item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
!\end{description}
!
!EOP
integer :: localrc ! local error status
type(ESMF_InterArray) :: exclusiveLBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveUBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveCountArg ! helper variable
type(ESMF_InterArray) :: computationalLBoundArg ! helper variable
type(ESMF_InterArray) :: computationalUBoundArg ! helper variable
type(ESMF_InterArray) :: computationalCountArg ! helper variable
type(ESMF_InterArray) :: totalLBoundArg ! helper variable
type(ESMF_InterArray) :: totalUBoundArg ! helper variable
type(ESMF_InterArray) :: totalCountArg ! helper variable
integer :: tmp_staggerloc
! 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_GridGetInit, grid, rc)
! handle staggerloc
if (present(staggerloc)) then
tmp_staggerloc=staggerloc%staggerloc
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc ! default
endif
! process optional arguments
exclusiveLBoundArg=ESMF_InterArrayCreate(exclusiveLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveUBoundArg=ESMF_InterArrayCreate(exclusiveUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveCountArg=ESMF_InterArrayCreate(exclusiveCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalLBoundArg=ESMF_InterArrayCreate(computationalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalUBoundArg=ESMF_InterArrayCreate(computationalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalCountArg=ESMF_InterArrayCreate(computationalCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalLBoundArg=ESMF_InterArrayCreate(totalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalUBoundArg = ESMF_InterArrayCreate(totalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalCountArg = ESMF_InterArrayCreate(totalCount, 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_GridGetCoordBounds(grid, localDE, coordDim, tmp_staggerloc, &
exclusiveLBoundArg, exclusiveUBoundArg, exclusiveCountArg, &
computationalLBoundArg, computationalUBoundArg, computationalCountArg,&
totalLBoundArg, totalUBoundArg, totalCountArg, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate interface ints
call ESMF_InterArrayDestroy(exclusiveLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalCountArg, 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_GridGetCoordBounds
!------------------------------------------------------------------------------
!BOP
!\label{API:GridGetItem}
! !IROUTINE: ESMF_GridGetItem - Get a DE-local Fortran array pointer to Grid item data and item bounds
! !INTERFACE:
! subroutine ESMF_GridGetItem<rank><type><kind>(grid, itemflag, keywordEnforcer, &
! staggerloc, localDE, farrayPtr, datacopyflag, &
! exclusiveLBound, exclusiveUBound, exclusiveCount, &
! computationalLBound, computationalUBound, computationalCount, &
! totalLBound, totalUBound, totalCount, rc)
!
! !ARGUMENTS:
! type(ESMF_Grid), intent(in) :: grid
! type (ESMF_GridItem_Flag),intent(in) :: itemflag
!type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
! type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
! integer, intent(in), optional :: localDE
! <type> (ESMF_KIND_<kind>), pointer :: farrayPtr(<rank>)
! type(ESMF_DataCopy_Flag),intent(in), optional :: datacopyflag
! integer, intent(out), optional :: exclusiveLBound(:)
! integer, intent(out), optional :: exclusiveUBound(:)
! integer, intent(out), optional :: exclusiveCount(:)
! integer, intent(out), optional :: computationalLBound(:)
! integer, intent(out), optional :: computationalUBound(:)
! integer, intent(out), optional :: computationalCount(:)
! integer, intent(out), optional :: totalLBound(:)
! integer, intent(out), optional :: totalUBound(:)
! integer, intent(out), optional :: totalCount(:)
! integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \end{itemize}
!
! !DESCRIPTION:
! This method gets a Fortran pointer to the piece of memory which holds the
! item data on the local DE for the given stagger locations.
! This is useful, for example, for setting the item values in a Grid, or
! for reading the item values. Currently this method supports up to three
! grid dimensions, but is limited to the I4 datatype. See below for specific
! supported values. If the item values that you are trying to retrieve are of
! higher dimension, use the {\tt ESMF\_GetItem()} interface that returns coordinate
! values in an {\tt ESMF\_Array} instead. That interface supports the retrieval of
! coordinates up to 7D.
!
! Supported values for the farrayPtr argument are:
! \begin{description}
! \item integer(ESMF\_KIND\_I4), pointer :: farrayPtr(:)
! \item integer(ESMF\_KIND\_I4), pointer :: farrayPtr(:,:)
! \item integer(ESMF\_KIND\_I4), pointer :: farrayPtr(:,:,:)
! \item real(ESMF\_KIND\_R4), pointer :: farrayPtr(:)
! \item real(ESMF\_KIND\_R4), pointer :: farrayPtr(:,:)
! \item real(ESMF\_KIND\_R4), pointer :: farrayPtr(:,:,:)
! \item real(ESMF\_KIND\_R8), pointer :: farrayPtr(:)
! \item real(ESMF\_KIND\_R8), pointer :: farrayPtr(:,:)
! \item real(ESMF\_KIND\_R8), pointer :: farrayPtr(:,:,:)
! \end{description}
!
! The arguments are:
! \begin{description}
! \item[grid]
! Grid to get the information from.
! \item[itemflag]
! The item to get the information for. Please see Section~\ref{const:griditem} for a
! list of valid items.
! \item[{[staggerloc]}]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! \item[{[localDE]}]
! The 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]
! The pointer to the item data.
! \item[{[datacopyflag]}]
! If not specified, default to {\tt ESMF\_DATACOPY\_REFERENCE}, in this case
! farrayPtr is a reference to the data in the Grid item arrays.
! Please see Section~\ref{const:datacopyflag} for further description and a
! list of valid values.
! \item[{[exclusiveLBound]}]
! Upon return this holds the lower bounds of the exclusive region.
! {\tt exclusiveLBound} must be allocated to be of size equal to the grid dimCount.
! \item[{[exclusiveUBound]}]
! Upon return this holds the upper bounds of the exclusive region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the grid dimCount.
! \item[{[exclusiveCount]}]
! \begin{sloppypar}
! Upon return this holds the number of items in the exclusive region per dimension
! (i.e. {\tt exclusiveUBound-exclusiveLBound+1}). {\tt exclusiveCount} must
! be allocated to be of size equal to the grid dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \end{sloppypar}
! \item[{[computationalLBound]}]
! Upon return this holds the lower bounds of the stagger region.
! {\tt computationalLBound} must be allocated to be of size equal to the grid dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalUBound]}]
! Upon return this holds the upper bounds of the stagger region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the grid dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalCount]}]
! Upon return this holds the number of items in the computational region per dimension
! (i.e. {\tt computationalUBound-computationalLBound+1}). {\tt computationalCount}
! must be allocated to be of size equal to the grid dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalLBound]}]
! Upon return this holds the lower bounds of the total region.
! {\tt totalLBound} must be allocated to be of size equal to the grid dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalUBound]}]
! Upon return this holds the upper bounds of the total region.
! {\tt totalUBound} must be allocated to be of size equal to the grid dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalCount]}]
! \begin{sloppypar}
! Upon return this holds the number of items in the total region per dimension
! (i.e. {\tt totalUBound-totalLBound+1}). {\tt totalCount} must
! be allocated to be of size equal to the grid dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \end{sloppypar}
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetItem1DI4"
!BOPI
! !IROUTINE: ESMF_GridGetItem - Get pointer to 1DI4 coordinates
! !INTERFACE:
! Private name; call using ESMF_GridGetItem()
subroutine ESMF_GridGetItem1DI4(grid, itemflag, keywordEnforcer, &
staggerloc, localDE, farrayPtr, datacopyflag, &
exclusiveLBound, exclusiveUBound, exclusiveCount, &
computationalLBound, computationalUBound, computationalCount, &
totalLBound, totalUBound, totalCount, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type (ESMF_GridItem_Flag), intent(in) :: itemflag
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
integer, intent(in), optional :: localDE
integer(ESMF_KIND_I4), pointer :: farrayPtr(:)
type(ESMF_DataCopy_Flag), intent(in), optional :: datacopyflag
integer, target, intent(out), optional :: exclusiveLBound(:)
integer, target, intent(out), optional :: exclusiveUBound(:)
integer, target, intent(out), optional :: exclusiveCount(:)
integer, target, intent(out), optional :: computationalLBound(:)
integer, target, intent(out), optional :: computationalUBound(:)
integer, target, intent(out), optional :: computationalCount(:)
integer, target, intent(out), optional :: totalLBound(:)
integer, target, intent(out), optional :: totalUBound(:)
integer, target, intent(out), optional :: totalCount(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This method gets a Fortran pointer to the piece of memory which holds the
! item data for the stagger locations on the given local DE.
! This is useful, for example, for setting the item values in a Grid, or
! for reading the item values.
!
! The arguments are:
! \begin{description}
! \item[{grid}]
! Grid to get the information from.
! \item[{itemflag}]
! The item to get the information for. Please see Section~\ref{const:griditem} for a
! list of valid items.
! \item[{staggerloc}]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! \item[{[localDE]}]
! The 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}]
! The pointer to the item data.
! \item[{[datacopyflag]}]
! If not specified, default to {\tt ESMF\_DATACOPY\_REFERENCE}, in this case
! farrayPtr is a reference to the data in the Grid item arrays.
! Please see Section~\ref{const:datacopyflag} for further description and a
! list of valid values.
! \item[{[exclusiveLBound]}]
! Upon return this holds the lower bounds of the exclusive region.
! {\tt exclusiveLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveUBound]}]
! Upon return this holds the upper bounds of the exclusive region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveCount]}]
! Upon return this holds the number of items in the exclusive region per dimension
! (i.e. {\tt exclusiveUBound-exclusiveLBound+1}). {\tt exclusiveCount} must
! be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalLBound]}]
! Upon return this holds the lower bounds of the stagger region.
! {\tt computationalLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalUBound]}]
! Upon return this holds the upper bounds of the stagger region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalCount]}]
! Upon return this holds the number of items in the computational region per dimension
! (i.e. {\tt computationalUBound-computationalLBound+1}). {\tt computationalCount}
! must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalLBound]}]
! Upon return this holds the lower bounds of the total region.
! {\tt totalLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalUBound]}]
! Upon return this holds the upper bounds of the total region.
! {\tt totalUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalCount]}]
! Upon return this holds the number of items in the total region per dimension
! (i.e. {\tt totalUBound-totalLBound+1}). {\tt totalCount} must
! be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
! Local variables
type(ESMF_Array) :: array
integer :: localrc ! local error status
integer :: dimCount
type(ESMF_TypeKind_Flag) :: typekind
type(ESMF_LocalArray) :: localArray
type(ESMF_DataCopy_Flag) :: datacopyflagInt
integer :: coordDimCount(ESMF_MAXDIM)
type(ESMF_InterArray) :: exclusiveLBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveUBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveCountArg ! helper variable
type(ESMF_InterArray) :: computationalLBoundArg ! helper variable
type(ESMF_InterArray) :: computationalUBoundArg ! helper variable
type(ESMF_InterArray) :: computationalCountArg ! helper variable
type(ESMF_InterArray) :: totalLBoundArg ! helper variable
type(ESMF_InterArray) :: totalUBoundArg ! helper variable
type(ESMF_InterArray) :: totalCountArg ! helper variable
integer :: tmp_staggerloc
! 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_GridGetInit, grid, rc)
! Check consistency
call ESMF_GridGet(grid, dimCount=dimCount, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Require farrayPtr dimCount to match grid dimCount
if (dimCount /= 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- farrayPtr dimCount does not match requested item dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Set Defaults
if (present(datacopyflag)) then
datacopyflagInt=datacopyflag
else
datacopyflagInt=ESMF_DATACOPY_REFERENCE
endif
!! localDE is error checked inside ESMF_ArrayGet() and GetCoordBounds(), so don't do it here !!
! handle staggerloc
if (present(staggerloc)) then
tmp_staggerloc=staggerloc%staggerloc
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc ! default
endif
! Get the Array
call ESMF_GridGetItemIntoArray(grid, itemflag, staggerloc, array, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
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=datacopyflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! process optional arguments
exclusiveLBoundArg=ESMF_InterArrayCreate(exclusiveLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveUBoundArg=ESMF_InterArrayCreate(exclusiveUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveCountArg=ESMF_InterArrayCreate(exclusiveCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalLBoundArg=ESMF_InterArrayCreate(computationalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalUBoundArg=ESMF_InterArrayCreate(computationalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalCountArg=ESMF_InterArrayCreate(computationalCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalLBoundArg=ESMF_InterArrayCreate(totalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalUBoundArg = ESMF_InterArrayCreate(totalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalCountArg = ESMF_InterArrayCreate(totalCount, 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_GridGetItemBounds(grid, localDE, tmp_staggerloc, itemflag, &
exclusiveLBoundArg, exclusiveUBoundArg, exclusiveCountArg, &
computationalLBoundArg, computationalUBoundArg, computationalCountArg,&
totalLBoundArg, totalUBoundArg, totalCountArg, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate interface ints
call ESMF_InterArrayDestroy(exclusiveLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalCountArg, 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_GridGetItem1DI4
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetItem2DI4"
!BOPI
! !IROUTINE: ESMF_GridGetItem - Get pointer to 2DI4 item
! !INTERFACE:
! Private name; call using ESMF_GridGetItem()
subroutine ESMF_GridGetItem2DI4(grid, itemflag, keywordEnforcer, &
staggerloc, localDE, farrayPtr, datacopyflag, &
exclusiveLBound, exclusiveUBound, exclusiveCount, &
computationalLBound, computationalUBound, computationalCount, &
totalLBound, totalUBound, totalCount, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type (ESMF_GridItem_Flag), intent(in) :: itemflag
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
integer, intent(in), optional :: localDE
integer(ESMF_KIND_I4), pointer :: farrayPtr(:,:)
type(ESMF_DataCopy_Flag), intent(in), optional :: datacopyflag
integer, target, intent(out), optional :: exclusiveLBound(:)
integer, target, intent(out), optional :: exclusiveUBound(:)
integer, target, intent(out), optional :: exclusiveCount(:)
integer, target, intent(out), optional :: computationalLBound(:)
integer, target, intent(out), optional :: computationalUBound(:)
integer, target, intent(out), optional :: computationalCount(:)
integer, target, intent(out), optional :: totalLBound(:)
integer, target, intent(out), optional :: totalUBound(:)
integer, target, intent(out), optional :: totalCount(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This method gets a Fortran pointer to the piece of memory which holds the
! item data for the stagger locations on the given local DE.
! This is useful, for example, for setting the item values in a Grid, or
! for reading the item values.
!
! The arguments are:
! \begin{description}
! \item[{grid}]
! Grid to get the information from.
! \item[{itemflag}]
! The item to get the information for. Please see Section~\ref{const:griditem} for a
! list of valid items.
! \item[{staggerloc}]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
! \item[{[localDE]}]
! The 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}]
! The pointer to the item data.
! \item[{[datacopyflag]}]
! If not specified, default to {\tt ESMF\_DATACOPY\_REFERENCE}, in this case
! farrayPtr is a reference to the data in the Grid item arrays.
! Please see Section~\ref{const:datacopyflag} for further description and a
! list of valid values.
! \item[{[exclusiveLBound]}]
! Upon return this holds the lower bounds of the exclusive region.
! {\tt exclusiveLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveUBound]}]
! Upon return this holds the upper bounds of the exclusive region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveCount]}]
! Upon return this holds the number of items in the exclusive region per dimension
! (i.e. {\tt exclusiveUBound-exclusiveLBound+1}). {\tt exclusiveCount} must
! be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalLBound]}]
! Upon return this holds the lower bounds of the stagger region.
! {\tt computationalLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalUBound]}]
! Upon return this holds the upper bounds of the stagger region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalCount]}]
! Upon return this holds the number of items in the computational region per dimension
! (i.e. {\tt computationalUBound-computationalLBound+1}). {\tt computationalCount}
! must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalLBound]}]
! Upon return this holds the lower bounds of the total region.
! {\tt totalLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalUBound]}]
! Upon return this holds the upper bounds of the total region.
! {\tt totalUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalCount]}]
! Upon return this holds the number of items in the total region per dimension
! (i.e. {\tt totalUBound-totalLBound+1}). {\tt totalCount} must
! be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
! Local variables
type(ESMF_Array) :: array
integer :: localrc ! local error status
integer :: dimCount
type(ESMF_TypeKind_Flag) :: typekind
type(ESMF_LocalArray) :: localArray
type(ESMF_DataCopy_Flag) :: datacopyflagInt
integer :: coordDimCount(ESMF_MAXDIM)
type(ESMF_InterArray) :: exclusiveLBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveUBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveCountArg ! helper variable
type(ESMF_InterArray) :: computationalLBoundArg ! helper variable
type(ESMF_InterArray) :: computationalUBoundArg ! helper variable
type(ESMF_InterArray) :: computationalCountArg ! helper variable
type(ESMF_InterArray) :: totalLBoundArg ! helper variable
type(ESMF_InterArray) :: totalUBoundArg ! helper variable
type(ESMF_InterArray) :: totalCountArg ! helper variable
integer :: tmp_staggerloc
! 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_GridGetInit, grid, rc)
! Check consistency
call ESMF_GridGet(grid, dimCount=dimCount, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Require farrayPtr dimCount to match grid dimCount
if (dimCount /= 2) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- farrayPtr dimCount does not match requested item dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Set Defaults
if (present(datacopyflag)) then
datacopyflagInt=datacopyflag
else
datacopyflagInt=ESMF_DATACOPY_REFERENCE
endif
!! localDE is error checked inside ESMF_ArrayGet() and GetCoordBounds(), so don't do it here !!
! handle staggerloc
if (present(staggerloc)) then
tmp_staggerloc=staggerloc%staggerloc
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc ! default
endif
! Get the Array
call ESMF_GridGetItemIntoArray(grid, itemflag, staggerloc, array, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
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=datacopyflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! process optional arguments
exclusiveLBoundArg=ESMF_InterArrayCreate(exclusiveLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveUBoundArg=ESMF_InterArrayCreate(exclusiveUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveCountArg=ESMF_InterArrayCreate(exclusiveCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalLBoundArg=ESMF_InterArrayCreate(computationalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalUBoundArg=ESMF_InterArrayCreate(computationalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalCountArg=ESMF_InterArrayCreate(computationalCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalLBoundArg=ESMF_InterArrayCreate(totalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalUBoundArg = ESMF_InterArrayCreate(totalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalCountArg = ESMF_InterArrayCreate(totalCount, 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_GridGetItemBounds(grid, localDE, tmp_staggerloc, itemflag, &
exclusiveLBoundArg, exclusiveUBoundArg, exclusiveCountArg, &
computationalLBoundArg, computationalUBoundArg, computationalCountArg,&
totalLBoundArg, totalUBoundArg, totalCountArg, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate interface ints
call ESMF_InterArrayDestroy(exclusiveLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalCountArg, 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_GridGetItem2DI4
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetItem3DI4"
!BOPI
! !IROUTINE: ESMF_GridGetItem - Get pointer to 3DI4 item
! !INTERFACE:
! Private name; call using ESMF_GridGetItem()
subroutine ESMF_GridGetItem3DI4(grid, itemflag, keywordEnforcer, &
staggerloc, localDE, farrayPtr, datacopyflag, &
exclusiveLBound, exclusiveUBound, exclusiveCount, &
computationalLBound, computationalUBound, computationalCount, &
totalLBound, totalUBound, totalCount, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type (ESMF_GridItem_Flag), intent(in) :: itemflag
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
integer, intent(in), optional :: localDE
integer(ESMF_KIND_I4), pointer :: farrayPtr(:,:,:)
type(ESMF_DataCopy_Flag), intent(in), optional :: datacopyflag
integer, target, intent(out), optional :: exclusiveLBound(:)
integer, target, intent(out), optional :: exclusiveUBound(:)
integer, target, intent(out), optional :: exclusiveCount(:)
integer, target, intent(out), optional :: computationalLBound(:)
integer, target, intent(out), optional :: computationalUBound(:)
integer, target, intent(out), optional :: computationalCount(:)
integer, target, intent(out), optional :: totalLBound(:)
integer, target, intent(out), optional :: totalUBound(:)
integer, target, intent(out), optional :: totalCount(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This method gets a Fortran pointer to the piece of memory which holds the
! maks data and stagger locations on the given local DE.
! This is useful, for example, for setting the item values in a Grid, or
! for reading the item values.
!
! The arguments are:
! \begin{description}
! \item[{grid}]
! Grid to get the information from.
! \item[{itemflag}]
! The item to get the information for. Please see Section~\ref{const:griditem} for a
! list of valid items.
! \item[{staggerloc}]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
! \item[{[localDE]}]
! The 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}]
! The pointer to the item data.
! \item[{[datacopyflag]}]
! If not specified, default to {\tt ESMF\_DATACOPY\_REFERENCE}, in this case
! farrayPtr is a reference to the data in the Grid item arrays.
! Please see Section~\ref{const:datacopyflag} for further description and a
! list of valid values.
! \item[{[exclusiveLBound]}]
! Upon return this holds the lower bounds of the exclusive region.
! {\tt exclusiveLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveUBound]}]
! Upon return this holds the upper bounds of the exclusive region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveCount]}]
! Upon return this holds the number of items in the exclusive region per dimension
! (i.e. {\tt exclusiveUBound-exclusiveLBound+1}). {\tt exclusiveCount} must
! be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalLBound]}]
! Upon return this holds the lower bounds of the stagger region.
! {\tt computationalLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalUBound]}]
! Upon return this holds the upper bounds of the stagger region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalCount]}]
! Upon return this holds the number of items in the computational region per dimension
! (i.e. {\tt computationalUBound-computationalLBound+1}). {\tt computationalCount}
! must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalLBound]}]
! Upon return this holds the lower bounds of the total region.
! {\tt totalLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalUBound]}]
! Upon return this holds the upper bounds of the total region.
! {\tt totalUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalCount]}]
! Upon return this holds the number of items in the total region per dimension
! (i.e. {\tt totalUBound-totalLBound+1}). {\tt totalCount} must
! be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
! Local variables
type(ESMF_Array) :: array
integer :: localrc ! local error status
integer :: dimCount
type(ESMF_TypeKind_Flag) :: typekind
type(ESMF_LocalArray) :: localArray
type(ESMF_DataCopy_Flag) :: datacopyflagInt
integer :: coordDimCount(ESMF_MAXDIM)
type(ESMF_InterArray) :: exclusiveLBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveUBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveCountArg ! helper variable
type(ESMF_InterArray) :: computationalLBoundArg ! helper variable
type(ESMF_InterArray) :: computationalUBoundArg ! helper variable
type(ESMF_InterArray) :: computationalCountArg ! helper variable
type(ESMF_InterArray) :: totalLBoundArg ! helper variable
type(ESMF_InterArray) :: totalUBoundArg ! helper variable
type(ESMF_InterArray) :: totalCountArg ! helper variable
integer :: tmp_staggerloc
! 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_GridGetInit, grid, rc)
! Check consistency
call ESMF_GridGet(grid, dimCount=dimCount, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Require farrayPtr dimCount to match coordinate dimCount
if (dimCount /= 3) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- farrayPtr dimCount does not match requested item dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Set Defaults
if (present(datacopyflag)) then
datacopyflagInt=datacopyflag
else
datacopyflagInt=ESMF_DATACOPY_REFERENCE
endif
!! localDE is error checked inside ESMF_ArrayGet() and GetCoordBounds(), so don't do it here !!
! handle staggerloc
if (present(staggerloc)) then
tmp_staggerloc=staggerloc%staggerloc
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc ! default
endif
! Get the Array
call ESMF_GridGetItemIntoArray(grid, itemflag, staggerloc, array, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
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=datacopyflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! process optional arguments
exclusiveLBoundArg=ESMF_InterArrayCreate(exclusiveLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveUBoundArg=ESMF_InterArrayCreate(exclusiveUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveCountArg=ESMF_InterArrayCreate(exclusiveCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalLBoundArg=ESMF_InterArrayCreate(computationalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalUBoundArg=ESMF_InterArrayCreate(computationalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalCountArg=ESMF_InterArrayCreate(computationalCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalLBoundArg=ESMF_InterArrayCreate(totalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalUBoundArg = ESMF_InterArrayCreate(totalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalCountArg = ESMF_InterArrayCreate(totalCount, 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_GridGetItemBounds(grid, localDE, tmp_staggerloc, itemflag, &
exclusiveLBoundArg, exclusiveUBoundArg, exclusiveCountArg, &
computationalLBoundArg, computationalUBoundArg, computationalCountArg,&
totalLBoundArg, totalUBoundArg, totalCountArg, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate interface ints
call ESMF_InterArrayDestroy(exclusiveLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalCountArg, 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_GridGetItem3DI4
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetItem1DR4"
!BOPI
! !IROUTINE: ESMF_GridGetItem - Get pointer to 1DR4 coordinates
! !INTERFACE:
! Private name; call using ESMF_GridGetItem()
subroutine ESMF_GridGetItem1DR4(grid, itemflag, keywordEnforcer, &
staggerloc, localDE, farrayPtr, datacopyflag, &
exclusiveLBound, exclusiveUBound, exclusiveCount, &
computationalLBound, computationalUBound, computationalCount, &
totalLBound, totalUBound, totalCount, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type (ESMF_GridItem_Flag), intent(in) :: itemflag
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
integer, intent(in), optional :: localDE
real(ESMF_KIND_R4), pointer :: farrayPtr(:)
type(ESMF_DataCopy_Flag), intent(in), optional :: datacopyflag
integer, target, intent(out), optional :: exclusiveLBound(:)
integer, target, intent(out), optional :: exclusiveUBound(:)
integer, target, intent(out), optional :: exclusiveCount(:)
integer, target, intent(out), optional :: computationalLBound(:)
integer, target, intent(out), optional :: computationalUBound(:)
integer, target, intent(out), optional :: computationalCount(:)
integer, target, intent(out), optional :: totalLBound(:)
integer, target, intent(out), optional :: totalUBound(:)
integer, target, intent(out), optional :: totalCount(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This method gets a Fortran pointer to the piece of memory which holds the
! item data for the stagger locations on the given local DE.
! This is useful, for example, for setting the item values in a Grid, or
! for reading the item values.
!
! The arguments are:
! \begin{description}
! \item[{grid}]
! Grid to get the information from.
! \item[{itemflag}]
! The item to get the information for. Please see Section~\ref{const:griditem} for a
! list of valid items.
! \item[{staggerloc}]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! \item[{[localDE]}]
! The 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}]
! The pointer to the item data.
! \item[{[datacopyflag]}]
! If not specified, default to {\tt ESMF\_DATACOPY\_REFERENCE}, in this case
! farrayPtr is a reference to the data in the Grid item arrays.
! Please see Section~\ref{const:datacopyflag} for further description and a
! list of valid values.
! \item[{[exclusiveLBound]}]
! Upon return this holds the lower bounds of the exclusive region.
! {\tt exclusiveLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveUBound]}]
! Upon return this holds the upper bounds of the exclusive region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveCount]}]
! Upon return this holds the number of items in the exclusive region per dimension
! (i.e. {\tt exclusiveUBound-exclusiveLBound+1}). {\tt exclusiveCount} must
! be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalLBound]}]
! Upon return this holds the lower bounds of the stagger region.
! {\tt computationalLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalUBound]}]
! Upon return this holds the upper bounds of the stagger region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalCount]}]
! Upon return this holds the number of items in the computational region per dimension
! (i.e. {\tt computationalUBound-computationalLBound+1}). {\tt computationalCount}
! must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalLBound]}]
! Upon return this holds the lower bounds of the total region.
! {\tt totalLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalUBound]}]
! Upon return this holds the upper bounds of the total region.
! {\tt totalUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalCount]}]
! Upon return this holds the number of items in the total region per dimension
! (i.e. {\tt totalUBound-totalLBound+1}). {\tt totalCount} must
! be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
! Local variables
type(ESMF_Array) :: array
integer :: localrc ! local error status
integer :: dimCount
type(ESMF_TypeKind_Flag) :: typekind
type(ESMF_LocalArray):: localarray
type(ESMF_DataCopy_Flag) :: datacopyflagInt
integer :: coordDimCount(ESMF_MAXDIM)
type(ESMF_InterArray) :: exclusiveLBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveUBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveCountArg ! helper variable
type(ESMF_InterArray) :: computationalLBoundArg ! helper variable
type(ESMF_InterArray) :: computationalUBoundArg ! helper variable
type(ESMF_InterArray) :: computationalCountArg ! helper variable
type(ESMF_InterArray) :: totalLBoundArg ! helper variable
type(ESMF_InterArray) :: totalUBoundArg ! helper variable
type(ESMF_InterArray) :: totalCountArg ! helper variable
integer :: tmp_staggerloc
! 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_GridGetInit, grid, rc)
! Check consistency
call ESMF_GridGet(grid, dimCount=dimCount, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Require farrayPtr dimCount to match grid dimCount
if (dimCount /= 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- farrayPtr dimCount does not match requested item dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Set Defaults
if (present(datacopyflag)) then
datacopyflagInt=datacopyflag
else
datacopyflagInt=ESMF_DATACOPY_REFERENCE
endif
!! localDE is error checked inside ESMF_ArrayGet() and GetCoordBounds(), so don't do it here !!
! handle staggerloc
if (present(staggerloc)) then
tmp_staggerloc=staggerloc%staggerloc
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc ! default
endif
! Get the Array
call ESMF_GridGetItemIntoArray(grid, itemflag, staggerloc, array, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
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=datacopyflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! process optional arguments
exclusiveLBoundArg=ESMF_InterArrayCreate(exclusiveLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveUBoundArg=ESMF_InterArrayCreate(exclusiveUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveCountArg=ESMF_InterArrayCreate(exclusiveCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalLBoundArg=ESMF_InterArrayCreate(computationalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalUBoundArg=ESMF_InterArrayCreate(computationalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalCountArg=ESMF_InterArrayCreate(computationalCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalLBoundArg=ESMF_InterArrayCreate(totalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalUBoundArg = ESMF_InterArrayCreate(totalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalCountArg = ESMF_InterArrayCreate(totalCount, 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_GridGetItemBounds(grid, localDE, tmp_staggerloc, itemflag, &
exclusiveLBoundArg, exclusiveUBoundArg, exclusiveCountArg, &
computationalLBoundArg, computationalUBoundArg, computationalCountArg,&
totalLBoundArg, totalUBoundArg, totalCountArg, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate interface ints
call ESMF_InterArrayDestroy(exclusiveLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalCountArg, 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_GridGetItem1DR4
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetItem2DR4"
!BOPI
! !IROUTINE: ESMF_GridGetItem - Get pointer to 2DR4 item
! !INTERFACE:
! Private name; call using ESMF_GridGetItem()
subroutine ESMF_GridGetItem2DR4(grid, itemflag, keywordEnforcer, &
staggerloc, localDE, farrayPtr, datacopyflag, &
exclusiveLBound, exclusiveUBound, exclusiveCount, &
computationalLBound, computationalUBound, computationalCount, &
totalLBound, totalUBound, totalCount, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type (ESMF_GridItem_Flag), intent(in) :: itemflag
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
integer, intent(in), optional :: localDE
real(ESMF_KIND_R4), pointer :: farrayPtr(:,:)
type(ESMF_DataCopy_Flag), intent(in), optional :: datacopyflag
integer, target, intent(out), optional :: exclusiveLBound(:)
integer, target, intent(out), optional :: exclusiveUBound(:)
integer, target, intent(out), optional :: exclusiveCount(:)
integer, target, intent(out), optional :: computationalLBound(:)
integer, target, intent(out), optional :: computationalUBound(:)
integer, target, intent(out), optional :: computationalCount(:)
integer, target, intent(out), optional :: totalLBound(:)
integer, target, intent(out), optional :: totalUBound(:)
integer, target, intent(out), optional :: totalCount(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This method gets a Fortran pointer to the piece of memory which holds the
! item data for the stagger locations on the given local DE.
! This is useful, for example, for setting the item values in a Grid, or
! for reading the item values.
!
! The arguments are:
! \begin{description}
! \item[{grid}]
! Grid to get the information from.
! \item[{itemflag}]
! The item to get the information for. Please see Section~\ref{const:griditem} for a
! list of valid items.
! \item[{staggerloc}]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
! \item[{[localDE]}]
! The 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}]
! The pointer to the item data.
! \item[{[datacopyflag]}]
! If not specified, default to {\tt ESMF\_DATACOPY\_REFERENCE}, in this case
! farrayPtr is a reference to the data in the Grid item arrays.
! Please see Section~\ref{const:datacopyflag} for further description and a
! list of valid values.
! \item[{[exclusiveLBound]}]
! Upon return this holds the lower bounds of the exclusive region.
! {\tt exclusiveLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveUBound]}]
! Upon return this holds the upper bounds of the exclusive region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveCount]}]
! Upon return this holds the number of items in the exclusive region per dimension
! (i.e. {\tt exclusiveUBound-exclusiveLBound+1}). {\tt exclusiveCount} must
! be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalLBound]}]
! Upon return this holds the lower bounds of the stagger region.
! {\tt computationalLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalUBound]}]
! Upon return this holds the upper bounds of the stagger region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalCount]}]
! Upon return this holds the number of items in the computational region per dimension
! (i.e. {\tt computationalUBound-computationalLBound+1}). {\tt computationalCount}
! must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalLBound]}]
! Upon return this holds the lower bounds of the total region.
! {\tt totalLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalUBound]}]
! Upon return this holds the upper bounds of the total region.
! {\tt totalUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalCount]}]
! Upon return this holds the number of items in the total region per dimension
! (i.e. {\tt totalUBound-totalLBound+1}). {\tt totalCount} must
! be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
! Local variables
type(ESMF_Array) :: array
integer :: localrc ! local error status
integer :: localDECount, dimCount
type(ESMF_TypeKind_Flag) :: typekind
type(ESMF_LocalArray) :: localarray
type(ESMF_DataCopy_Flag) :: datacopyflagInt
integer :: coordDimCount(ESMF_MAXDIM)
type(ESMF_InterArray) :: exclusiveLBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveUBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveCountArg ! helper variable
type(ESMF_InterArray) :: computationalLBoundArg ! helper variable
type(ESMF_InterArray) :: computationalUBoundArg ! helper variable
type(ESMF_InterArray) :: computationalCountArg ! helper variable
type(ESMF_InterArray) :: totalLBoundArg ! helper variable
type(ESMF_InterArray) :: totalUBoundArg ! helper variable
type(ESMF_InterArray) :: totalCountArg ! helper variable
integer :: tmp_staggerloc
! 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_GridGetInit, grid, rc)
! Check consistency
call ESMF_GridGet(grid, dimCount=dimCount, &
localDECount=localDECount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Require farrayPtr dimCount to match grid dimCount
if (dimCount /= 2) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- farrayPtr dimCount does not match requested item dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Set Defaults
if (present(datacopyflag)) then
datacopyflagInt=datacopyflag
else
datacopyflagInt=ESMF_DATACOPY_REFERENCE
endif
!! localDE is error checked inside ESMF_ArrayGet() and GetCoordBounds(), so don't do it here !!
! handle staggerloc
if (present(staggerloc)) then
tmp_staggerloc=staggerloc%staggerloc
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc ! default
endif
! Get the Array
call ESMF_GridGetItemIntoArray(grid, itemflag, staggerloc, array, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
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=datacopyflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! process optional arguments
exclusiveLBoundArg=ESMF_InterArrayCreate(exclusiveLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveUBoundArg=ESMF_InterArrayCreate(exclusiveUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveCountArg=ESMF_InterArrayCreate(exclusiveCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalLBoundArg=ESMF_InterArrayCreate(computationalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalUBoundArg=ESMF_InterArrayCreate(computationalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalCountArg=ESMF_InterArrayCreate(computationalCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalLBoundArg=ESMF_InterArrayCreate(totalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalUBoundArg = ESMF_InterArrayCreate(totalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalCountArg = ESMF_InterArrayCreate(totalCount, 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_GridGetItemBounds(grid, localDE, tmp_staggerloc, itemflag, &
exclusiveLBoundArg, exclusiveUBoundArg, exclusiveCountArg, &
computationalLBoundArg, computationalUBoundArg, computationalCountArg,&
totalLBoundArg, totalUBoundArg, totalCountArg, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate interface ints
call ESMF_InterArrayDestroy(exclusiveLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalCountArg, 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_GridGetItem2DR4
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetItem3DR4"
!BOPI
! !IROUTINE: ESMF_GridGetItem - Get pointer to 3DR4 item
! !INTERFACE:
! Private name; call using ESMF_GridGetItem()
subroutine ESMF_GridGetItem3DR4(grid, itemflag, keywordEnforcer, &
staggerloc, localDE, farrayPtr, datacopyflag, &
exclusiveLBound, exclusiveUBound, exclusiveCount, &
computationalLBound, computationalUBound, computationalCount, &
totalLBound, totalUBound, totalCount, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type (ESMF_GridItem_Flag), intent(in) :: itemflag
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
integer, intent(in),optional :: localDE
real(ESMF_KIND_R4), pointer :: farrayPtr(:,:,:)
type(ESMF_DataCopy_Flag), intent(in), optional :: datacopyflag
integer, target, intent(out), optional :: exclusiveLBound(:)
integer, target, intent(out), optional :: exclusiveUBound(:)
integer, target, intent(out), optional :: exclusiveCount(:)
integer, target, intent(out), optional :: computationalLBound(:)
integer, target, intent(out), optional :: computationalUBound(:)
integer, target, intent(out), optional :: computationalCount(:)
integer, target, intent(out), optional :: totalLBound(:)
integer, target, intent(out), optional :: totalUBound(:)
integer, target, intent(out), optional :: totalCount(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This method gets a Fortran pointer to the piece of memory which holds the
! maks data and stagger locations on the given local DE.
! This is useful, for example, for setting the item values in a Grid, or
! for reading the item values.
!
! The arguments are:
! \begin{description}
! \item[{grid}]
! Grid to get the information from.
! \item[{itemflag}]
! The item to get the information for. Please see Section~\ref{const:griditem} for a
! list of valid items.
! \item[{staggerloc}]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
! \item[{[localDE]}]
! The 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}]
! The pointer to the item data.
! \item[{[datacopyflag]}]
! If not specified, default to {\tt ESMF\_DATACOPY\_REFERENCE}, in this case
! farrayPtr is a reference to the data in the Grid item arrays.
! Please see Section~\ref{const:datacopyflag} for further description and a
! list of valid values.
! \item[{[exclusiveLBound]}]
! Upon return this holds the lower bounds of the exclusive region.
! {\tt exclusiveLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveUBound]}]
! Upon return this holds the upper bounds of the exclusive region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveCount]}]
! Upon return this holds the number of items in the exclusive region per dimension
! (i.e. {\tt exclusiveUBound-exclusiveLBound+1}). {\tt exclusiveCount} must
! be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalLBound]}]
! Upon return this holds the lower bounds of the stagger region.
! {\tt computationalLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalUBound]}]
! Upon return this holds the upper bounds of the stagger region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalCount]}]
! Upon return this holds the number of items in the computational region per dimension
! (i.e. {\tt computationalUBound-computationalLBound+1}). {\tt computationalCount}
! must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalLBound]}]
! Upon return this holds the lower bounds of the total region.
! {\tt totalLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalUBound]}]
! Upon return this holds the upper bounds of the total region.
! {\tt totalUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalCount]}]
! Upon return this holds the number of items in the total region per dimension
! (i.e. {\tt totalUBound-totalLBound+1}). {\tt totalCount} must
! be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
! Local variables
type(ESMF_Array) :: array
integer :: localrc ! local error status
integer :: dimCount
type(ESMF_TypeKind_Flag) :: typekind
type(ESMF_LocalArray) :: localArray
type(ESMF_DataCopy_Flag) :: datacopyflagInt
integer :: coordDimCount(ESMF_MAXDIM)
type(ESMF_InterArray) :: exclusiveLBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveUBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveCountArg ! helper variable
type(ESMF_InterArray) :: computationalLBoundArg ! helper variable
type(ESMF_InterArray) :: computationalUBoundArg ! helper variable
type(ESMF_InterArray) :: computationalCountArg ! helper variable
type(ESMF_InterArray) :: totalLBoundArg ! helper variable
type(ESMF_InterArray) :: totalUBoundArg ! helper variable
type(ESMF_InterArray) :: totalCountArg ! helper variable
integer :: tmp_staggerloc
! 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_GridGetInit, grid, rc)
! Check consistency
call ESMF_GridGet(grid, dimCount=dimCount, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Require farrayPtr dimCount to match coordinate dimCount
if (dimCount /= 3) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- farrayPtr dimCount does not match requested item dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Set Defaults
if (present(datacopyflag)) then
datacopyflagInt=datacopyflag
else
datacopyflagInt=ESMF_DATACOPY_REFERENCE
endif
!! localDE is error checked inside ESMF_ArrayGet() and GetCoordBounds(), so don't do it here !!
! handle staggerloc
if (present(staggerloc)) then
tmp_staggerloc=staggerloc%staggerloc
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc ! default
endif
! Get the Array
call ESMF_GridGetItemIntoArray(grid, itemflag, staggerloc, array, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayGet(array, localarray=localarray, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_LocalArrayGet(localarray, farrayPtr, &
datacopyflag=datacopyflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! process optional arguments
exclusiveLBoundArg=ESMF_InterArrayCreate(exclusiveLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveUBoundArg=ESMF_InterArrayCreate(exclusiveUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveCountArg=ESMF_InterArrayCreate(exclusiveCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalLBoundArg=ESMF_InterArrayCreate(computationalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalUBoundArg=ESMF_InterArrayCreate(computationalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalCountArg=ESMF_InterArrayCreate(computationalCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalLBoundArg=ESMF_InterArrayCreate(totalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalUBoundArg = ESMF_InterArrayCreate(totalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalCountArg = ESMF_InterArrayCreate(totalCount, 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_GridGetItemBounds(grid, localDE, tmp_staggerloc, itemflag, &
exclusiveLBoundArg, exclusiveUBoundArg, exclusiveCountArg, &
computationalLBoundArg, computationalUBoundArg, computationalCountArg,&
totalLBoundArg, totalUBoundArg, totalCountArg, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate interface ints
call ESMF_InterArrayDestroy(exclusiveLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalCountArg, 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_GridGetItem3DR4
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetItem1DR8"
!BOPI
! !IROUTINE: ESMF_GridGetItem - Get pointer to 1DR8 coordinates
! !INTERFACE:
! Private name; call using ESMF_GridGetItem()
subroutine ESMF_GridGetItem1DR8(grid, itemflag, keywordEnforcer, &
staggerloc, localDE, farrayPtr, datacopyflag, &
exclusiveLBound, exclusiveUBound, exclusiveCount, &
computationalLBound, computationalUBound, computationalCount, &
totalLBound, totalUBound, totalCount, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type (ESMF_GridItem_Flag), intent(in) :: itemflag
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
integer, intent(in),optional :: localDE
real(ESMF_KIND_R8), pointer :: farrayPtr(:)
type(ESMF_DataCopy_Flag), intent(in), optional :: datacopyflag
integer, target, intent(out), optional :: exclusiveLBound(:)
integer, target, intent(out), optional :: exclusiveUBound(:)
integer, target, intent(out), optional :: exclusiveCount(:)
integer, target, intent(out), optional :: computationalLBound(:)
integer, target, intent(out), optional :: computationalUBound(:)
integer, target, intent(out), optional :: computationalCount(:)
integer, target, intent(out), optional :: totalLBound(:)
integer, target, intent(out), optional :: totalUBound(:)
integer, target, intent(out), optional :: totalCount(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This method gets a Fortran pointer to the piece of memory which holds the
! item data for the stagger locations on the given local DE.
! This is useful, for example, for setting the item values in a Grid, or
! for reading the item values.
!
! The arguments are:
! \begin{description}
! \item[{grid}]
! Grid to get the information from.
! \item[{itemflag}]
! The item to get the information for. Please see Section~\ref{const:griditem} for a
! list of valid items.
! \item[{staggerloc}]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! \item[{[localDE]}]
! The 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}]
! The pointer to the item data.
! \item[{[datacopyflag]}]
! If not specified, default to {\tt ESMF\_DATACOPY\_REFERENCE}, in this case
! farrayPtr is a reference to the data in the Grid item arrays.
! Please see Section~\ref{const:datacopyflag} for further description and a
! list of valid values.
! \item[{[exclusiveLBound]}]
! Upon return this holds the lower bounds of the exclusive region.
! {\tt exclusiveLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveUBound]}]
! Upon return this holds the upper bounds of the exclusive region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveCount]}]
! Upon return this holds the number of items in the exclusive region per dimension
! (i.e. {\tt exclusiveUBound-exclusiveLBound+1}). {\tt exclusiveCount} must
! be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalLBound]}]
! Upon return this holds the lower bounds of the stagger region.
! {\tt computationalLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalUBound]}]
! Upon return this holds the upper bounds of the stagger region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalCount]}]
! Upon return this holds the number of items in the computational region per dimension
! (i.e. {\tt computationalUBound-computationalLBound+1}). {\tt computationalCount}
! must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalLBound]}]
! Upon return this holds the lower bounds of the total region.
! {\tt totalLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalUBound]}]
! Upon return this holds the upper bounds of the total region.
! {\tt totalUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalCount]}]
! Upon return this holds the number of items in the total region per dimension
! (i.e. {\tt totalUBound-totalLBound+1}). {\tt totalCount} must
! be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
! Local variables
type(ESMF_Array) :: array
integer :: localrc ! local error status
integer :: dimCount
type(ESMF_TypeKind_Flag) :: typekind
type(ESMF_LocalArray) :: localArray
type(ESMF_DataCopy_Flag) :: datacopyflagInt
integer :: coordDimCount(ESMF_MAXDIM)
type(ESMF_InterArray) :: exclusiveLBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveUBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveCountArg ! helper variable
type(ESMF_InterArray) :: computationalLBoundArg ! helper variable
type(ESMF_InterArray) :: computationalUBoundArg ! helper variable
type(ESMF_InterArray) :: computationalCountArg ! helper variable
type(ESMF_InterArray) :: totalLBoundArg ! helper variable
type(ESMF_InterArray) :: totalUBoundArg ! helper variable
type(ESMF_InterArray) :: totalCountArg ! helper variable
integer :: tmp_staggerloc
! 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_GridGetInit, grid, rc)
! Check consistency
call ESMF_GridGet(grid, dimCount=dimCount, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Require farrayPtr dimCount to match grid dimCount
if (dimCount /= 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- farrayPtr dimCount does not match requested item dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Set Defaults
if (present(datacopyflag)) then
datacopyflagInt=datacopyflag
else
datacopyflagInt=ESMF_DATACOPY_REFERENCE
endif
!! localDE is error checked inside ESMF_ArrayGet() and GetCoordBounds(), so don't do it here !!
! handle staggerloc
if (present(staggerloc)) then
tmp_staggerloc=staggerloc%staggerloc
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc ! default
endif
! Get the Array
call ESMF_GridGetItemIntoArray(grid, itemflag, staggerloc, array, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayGet(array, localarray=localarray, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_LocalArrayGet(localarray, farrayPtr, &
datacopyflag=datacopyflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! process optional arguments
exclusiveLBoundArg=ESMF_InterArrayCreate(exclusiveLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveUBoundArg=ESMF_InterArrayCreate(exclusiveUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveCountArg=ESMF_InterArrayCreate(exclusiveCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalLBoundArg=ESMF_InterArrayCreate(computationalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalUBoundArg=ESMF_InterArrayCreate(computationalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalCountArg=ESMF_InterArrayCreate(computationalCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalLBoundArg=ESMF_InterArrayCreate(totalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalUBoundArg = ESMF_InterArrayCreate(totalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalCountArg = ESMF_InterArrayCreate(totalCount, 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_GridGetItemBounds(grid, localDE, tmp_staggerloc, itemflag, &
exclusiveLBoundArg, exclusiveUBoundArg, exclusiveCountArg, &
computationalLBoundArg, computationalUBoundArg, computationalCountArg,&
totalLBoundArg, totalUBoundArg, totalCountArg, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate interface ints
call ESMF_InterArrayDestroy(exclusiveLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalCountArg, 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_GridGetItem1DR8
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetItem2DR8"
!BOPI
! !IROUTINE: ESMF_GridGetItem - Get pointer to 2DR8 item
! !INTERFACE:
! Private name; call using ESMF_GridGetItem()
subroutine ESMF_GridGetItem2DR8(grid, itemflag, keywordEnforcer, &
staggerloc, localDE, farrayPtr, datacopyflag, &
exclusiveLBound, exclusiveUBound, exclusiveCount, &
computationalLBound, computationalUBound, computationalCount, &
totalLBound, totalUBound, totalCount, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type (ESMF_GridItem_Flag), intent(in) :: itemflag
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
integer, intent(in),optional :: localDE
real(ESMF_KIND_R8), pointer :: farrayPtr(:,:)
type(ESMF_DataCopy_Flag), intent(in), optional :: datacopyflag
integer, target, intent(out), optional :: exclusiveLBound(:)
integer, target, intent(out), optional :: exclusiveUBound(:)
integer, target, intent(out), optional :: exclusiveCount(:)
integer, target, intent(out), optional :: computationalLBound(:)
integer, target, intent(out), optional :: computationalUBound(:)
integer, target, intent(out), optional :: computationalCount(:)
integer, target, intent(out), optional :: totalLBound(:)
integer, target, intent(out), optional :: totalUBound(:)
integer, target, intent(out), optional :: totalCount(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This method gets a Fortran pointer to the piece of memory which holds the
! item data for the stagger locations on the given local DE.
! This is useful, for example, for setting the item values in a Grid, or
! for reading the item values.
!
! The arguments are:
! \begin{description}
! \item[{grid}]
! Grid to get the information from.
! \item[{itemflag}]
! The item to get the information for. Please see Section~\ref{const:griditem} for a
! list of valid items.
! \item[{staggerloc}]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
! \item[{[localDE]}]
! The 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}]
! The pointer to the item data.
! \item[{[datacopyflag]}]
! If not specified, default to {\tt ESMF\_DATACOPY\_REFERENCE}, in this case
! farrayPtr is a reference to the data in the Grid item arrays.
! Please see Section~\ref{const:datacopyflag} for further description and a
! list of valid values.
! \item[{[exclusiveLBound]}]
! Upon return this holds the lower bounds of the exclusive region.
! {\tt exclusiveLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveUBound]}]
! Upon return this holds the upper bounds of the exclusive region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveCount]}]
! Upon return this holds the number of items in the exclusive region per dimension
! (i.e. {\tt exclusiveUBound-exclusiveLBound+1}). {\tt exclusiveCount} must
! be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalLBound]}]
! Upon return this holds the lower bounds of the stagger region.
! {\tt computationalLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalUBound]}]
! Upon return this holds the upper bounds of the stagger region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalCount]}]
! Upon return this holds the number of items in the computational region per dimension
! (i.e. {\tt computationalUBound-computationalLBound+1}). {\tt computationalCount}
! must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalLBound]}]
! Upon return this holds the lower bounds of the total region.
! {\tt totalLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalUBound]}]
! Upon return this holds the upper bounds of the total region.
! {\tt totalUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalCount]}]
! Upon return this holds the number of items in the total region per dimension
! (i.e. {\tt totalUBound-totalLBound+1}). {\tt totalCount} must
! be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
! Local variables
type(ESMF_Array) :: array
integer :: localrc ! local error status
integer :: dimCount
type(ESMF_TypeKind_Flag) :: typekind
type(ESMF_LocalArray) :: localarray
type(ESMF_DataCopy_Flag) :: datacopyflagInt
integer :: coordDimCount(ESMF_MAXDIM)
type(ESMF_InterArray) :: exclusiveLBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveUBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveCountArg ! helper variable
type(ESMF_InterArray) :: computationalLBoundArg ! helper variable
type(ESMF_InterArray) :: computationalUBoundArg ! helper variable
type(ESMF_InterArray) :: computationalCountArg ! helper variable
type(ESMF_InterArray) :: totalLBoundArg ! helper variable
type(ESMF_InterArray) :: totalUBoundArg ! helper variable
type(ESMF_InterArray) :: totalCountArg ! helper variable
integer :: tmp_staggerloc
! 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_GridGetInit, grid, rc)
! Check consistency
call ESMF_GridGet(grid, dimCount=dimCount, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Require farrayPtr dimCount to match grid dimCount
if (dimCount /= 2) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- farrayPtr dimCount does not match requested item dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Set Defaults
if (present(datacopyflag)) then
datacopyflagInt=datacopyflag
else
datacopyflagInt=ESMF_DATACOPY_REFERENCE
endif
!! localDE is error checked inside ESMF_ArrayGet() and GetCoordBounds(), so don't do it here !!
! handle staggerloc
if (present(staggerloc)) then
tmp_staggerloc=staggerloc%staggerloc
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc ! default
endif
! Get the Array
call ESMF_GridGetItemIntoArray(grid, itemflag, staggerloc, array, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
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=datacopyflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! process optional arguments
exclusiveLBoundArg=ESMF_InterArrayCreate(exclusiveLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveUBoundArg=ESMF_InterArrayCreate(exclusiveUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveCountArg=ESMF_InterArrayCreate(exclusiveCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalLBoundArg=ESMF_InterArrayCreate(computationalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalUBoundArg=ESMF_InterArrayCreate(computationalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalCountArg=ESMF_InterArrayCreate(computationalCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalLBoundArg=ESMF_InterArrayCreate(totalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalUBoundArg = ESMF_InterArrayCreate(totalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalCountArg = ESMF_InterArrayCreate(totalCount, 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_GridGetItemBounds(grid, localDE, tmp_staggerloc, itemflag, &
exclusiveLBoundArg, exclusiveUBoundArg, exclusiveCountArg, &
computationalLBoundArg, computationalUBoundArg, computationalCountArg,&
totalLBoundArg, totalUBoundArg, totalCountArg, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate interface ints
call ESMF_InterArrayDestroy(exclusiveLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalCountArg, 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_GridGetItem2DR8
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetItem3DR8"
!BOPI
! !IROUTINE: ESMF_GridGetItem - Get pointer to 3DR8 item
! !INTERFACE:
! Private name; call using ESMF_GridGetItem()
subroutine ESMF_GridGetItem3DR8(grid, itemflag, keywordEnforcer, &
staggerloc, localDE, farrayPtr, datacopyflag, &
exclusiveLBound, exclusiveUBound, exclusiveCount, &
computationalLBound, computationalUBound, computationalCount, &
totalLBound, totalUBound, totalCount, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type (ESMF_GridItem_Flag), intent(in) :: itemflag
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
integer, intent(in),optional :: localDE
real(ESMF_KIND_R8), pointer :: farrayPtr(:,:,:)
type(ESMF_DataCopy_Flag), intent(in), optional :: datacopyflag
integer, target, intent(out), optional :: exclusiveLBound(:)
integer, target, intent(out), optional :: exclusiveUBound(:)
integer, target, intent(out), optional :: exclusiveCount(:)
integer, target, intent(out), optional :: computationalLBound(:)
integer, target, intent(out), optional :: computationalUBound(:)
integer, target, intent(out), optional :: computationalCount(:)
integer, target, intent(out), optional :: totalLBound(:)
integer, target, intent(out), optional :: totalUBound(:)
integer, target, intent(out), optional :: totalCount(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This method gets a Fortran pointer to the piece of memory which holds the
! maks data and stagger locations on the given local DE.
! This is useful, for example, for setting the item values in a Grid, or
! for reading the item values.
!
! The arguments are:
! \begin{description}
! \item[{grid}]
! Grid to get the information from.
! \item[{itemflag}]
! The item to get the information for. Please see Section~\ref{const:griditem} for a
! list of valid items.
! \item[{staggerloc}]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
! \item[{[localDE]}]
! The 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}]
! The pointer to the item data.
! \item[{[datacopyflag]}]
! If not specified, default to {\tt ESMF\_DATACOPY\_REFERENCE}, in this case
! farrayPtr is a reference to the data in the Grid item arrays.
! Please see Section~\ref{const:datacopyflag} for further description and a
! list of valid values.
! \item[{[exclusiveLBound]}]
! Upon return this holds the lower bounds of the exclusive region.
! {\tt exclusiveLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveUBound]}]
! Upon return this holds the upper bounds of the exclusive region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[exclusiveCount]}]
! Upon return this holds the number of items in the exclusive region per dimension
! (i.e. {\tt exclusiveUBound-exclusiveLBound+1}). {\tt exclusiveCount} must
! be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalLBound]}]
! Upon return this holds the lower bounds of the stagger region.
! {\tt computationalLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalUBound]}]
! Upon return this holds the upper bounds of the stagger region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[computationalCount]}]
! Upon return this holds the number of items in the computational region per dimension
! (i.e. {\tt computationalUBound-computationalLBound+1}). {\tt computationalCount}
! must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalLBound]}]
! Upon return this holds the lower bounds of the total region.
! {\tt totalLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalUBound]}]
! Upon return this holds the upper bounds of the total region.
! {\tt totalUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[totalCount]}]
! Upon return this holds the number of items in the total region per dimension
! (i.e. {\tt totalUBound-totalLBound+1}). {\tt totalCount} must
! be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
! Local variables
type(ESMF_Array) :: array
integer :: localrc ! local error status
integer :: dimCount
type(ESMF_TypeKind_Flag) :: typekind
type(ESMF_LocalArray) :: localarray
type(ESMF_DataCopy_Flag) :: datacopyflagInt
integer :: coordDimCount(ESMF_MAXDIM)
type(ESMF_InterArray) :: exclusiveLBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveUBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveCountArg ! helper variable
type(ESMF_InterArray) :: computationalLBoundArg ! helper variable
type(ESMF_InterArray) :: computationalUBoundArg ! helper variable
type(ESMF_InterArray) :: computationalCountArg ! helper variable
type(ESMF_InterArray) :: totalLBoundArg ! helper variable
type(ESMF_InterArray) :: totalUBoundArg ! helper variable
type(ESMF_InterArray) :: totalCountArg ! helper variable
integer :: tmp_staggerloc
! 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_GridGetInit, grid, rc)
! Check consistency
call ESMF_GridGet(grid, dimCount=dimCount, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Require farrayPtr dimCount to match coordinate dimCount
if (dimCount /= 3) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- farrayPtr dimCount does not match requested item dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Set Defaults
if (present(datacopyflag)) then
datacopyflagInt=datacopyflag
else
datacopyflagInt=ESMF_DATACOPY_REFERENCE
endif
!! localDE is error checked inside ESMF_ArrayGet() and GetCoordBounds(), so don't do it here !!
! handle staggerloc
if (present(staggerloc)) then
tmp_staggerloc=staggerloc%staggerloc
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc ! default
endif
! Get the Array
call ESMF_GridGetItemIntoArray(grid, itemflag, staggerloc, array, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
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=datacopyflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! process optional arguments
exclusiveLBoundArg=ESMF_InterArrayCreate(exclusiveLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveUBoundArg=ESMF_InterArrayCreate(exclusiveUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveCountArg=ESMF_InterArrayCreate(exclusiveCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalLBoundArg=ESMF_InterArrayCreate(computationalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalUBoundArg=ESMF_InterArrayCreate(computationalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalCountArg=ESMF_InterArrayCreate(computationalCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalLBoundArg=ESMF_InterArrayCreate(totalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalUBoundArg = ESMF_InterArrayCreate(totalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalCountArg = ESMF_InterArrayCreate(totalCount, 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_GridGetItemBounds(grid, localDE, tmp_staggerloc, itemflag, &
exclusiveLBoundArg, exclusiveUBoundArg, exclusiveCountArg, &
computationalLBoundArg, computationalUBoundArg, computationalCountArg,&
totalLBoundArg, totalUBoundArg, totalCountArg, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate interface ints
call ESMF_InterArrayDestroy(exclusiveLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalCountArg, 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_GridGetItem3DR8
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetItemIntoArray"
!BOP
!\label{API:GridGetItemIntoArray}
! !IROUTINE: ESMF_GridGetItem - Get a Grid item and put into an Array
! !INTERFACE:
! Private name; call using ESMF_GridGetItem()
subroutine ESMF_GridGetItemIntoArray(grid, itemflag, staggerloc, &
array, keywordEnforcer, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type (ESMF_GridItem_Flag), intent(in) :: itemflag
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
type(ESMF_Array), intent(out) :: array
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \end{itemize}
!
! !DESCRIPTION:
! This method allows the user to get access to the ESMF Array holding
! item data at a particular stagger location. This is useful, for example,
! to set the item values. To have an Array to access, the item Array
! must have already been allocated, for example by {\tt ESMF\_GridAddItem} or
! {\tt ESMF\_GridSetItem}.
!
! The arguments are:
! \begin{description}
! \item[grid]
! Grid to get the information from.
! \item[itemflag]
! The item from which to get the arrays. Please see Section~\ref{const:griditem} for a
! list of valid items.
! \item[{[staggerloc]}]
! The stagger location from which to get the arrays.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! \item[array]
! An array into which to put the item information.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
integer :: tmp_staggerloc
integer :: localrc ! local error status
type(ESMF_DataCopy_Flag) :: datacopyflag
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check init status of arguments
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, grid, rc)
! handle staggerloc
if (present(staggerloc)) then
tmp_staggerloc=staggerloc%staggerloc
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc
endif
! Init datacopyflag
datacopyflag=ESMF_DATACOPY_REFERENCE
! Call C++ Subroutine
call c_ESMC_gridgetitemintoarray(grid%this,tmp_staggerloc, itemflag, &
array, datacopyflag, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set Array as created
call ESMF_ArraySetInitCreated(array,localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridGetItemIntoArray
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetItemInfo"
!BOP
!\label{API:GridGetItemInfo}
! !IROUTINE: ESMF_GridGetItem - Get information about an item at a particular stagger location
! !INTERFACE:
! Private name; call using ESMF_GridGetItem()
subroutine ESMF_GridGetItemInfo(grid, itemflag, keywordEnforcer, &
staggerloc, isPresent, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type (ESMF_GridItem_Flag), intent(in) :: itemflag
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
logical, intent(out), optional :: isPresent
integer, intent(out), optional :: rc
!
!
! !DESCRIPTION:
! This method allows the user to get information about a given item on a given
! stagger.
!
! The arguments are:
! \begin{description}
! \item[grid]
! Grid to get the information from.
! \item[itemflag]
! The item for which to get information. Please see Section~\ref{const:griditem} for a
! list of valid items.
! \item[{[staggerloc]}]
! The stagger location for which to get information.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! \item[{[isPresent]}]
! If .true. then an item of type itemflag has been added to this staggerloc.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
integer :: tmp_staggerloc
integer :: localrc ! local error status
integer :: isPresentInt
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check init status of arguments
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, grid, rc)
! handle staggerloc
if (present(staggerloc)) then
tmp_staggerloc=staggerloc%staggerloc
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc
endif
! XMRKX
! Call C++ Subroutine
if (present(isPresent)) then
isPresent=.false.
call c_ESMC_gridgetitempresent(grid%this,tmp_staggerloc, itemflag, &
isPresentInt, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Interpret isPresentInt
if (isPresentInt==1) then
isPresent=.true.
else
isPresent=.false.
endif
endif
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridGetItemInfo
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetItemBounds"
!BOP
! !IROUTINE: ESMF_GridGetItemBounds - Get DE-local item bounds from a Grid
! !INTERFACE:
subroutine ESMF_GridGetItemBounds(grid, itemflag, keywordEnforcer, &
staggerloc, localDE, &
exclusiveLBound, exclusiveUBound, exclusiveCount, &
computationalLBound, computationalUBound, computationalCount, &
totalLBound, totalUBound, totalCount, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type (ESMF_GridItem_Flag), intent(in) :: itemflag
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
integer, intent(in), optional :: localDE
integer, target, intent(out), optional :: exclusiveLBound(:)
integer, target, intent(out), optional :: exclusiveUBound(:)
integer, target, intent(out), optional :: exclusiveCount(:)
integer, target, intent(out), optional :: computationalLBound(:)
integer, target, intent(out), optional :: computationalUBound(:)
integer, target, intent(out), optional :: computationalCount(:)
integer, target, intent(out), optional :: totalLBound(:)
integer, target, intent(out), optional :: totalUBound(:)
integer, target, intent(out), optional :: totalCount(:)
integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \end{itemize}
!
! !DESCRIPTION:
! This method gets information about the range of index space which a particular
! piece of item data occupies. In other words, this method returns the
! bounds of the item arrays. Note that unlike the output from the
! Array, these values also include the undistributed dimensions and are
! ordered to reflect the order of the indices in the item. So, for example,
! {\tt totalLBound} and {\tt totalUBound} should match the bounds of the Fortran array
! retrieved by {\tt ESMF\_GridGetItem}.
!
!The arguments are:
!\begin{description}
!\item[grid]
! Grid to get the information from.
!\item[itemflag]
! The item to get the information for. Please see Section~\ref{const:griditem} for a
! list of valid items.
!\item[{[staggerloc]}]
! The stagger location to get the information for.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
!\item[{[localDE]}]
! The 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[{[exclusiveLBound]}]
! Upon return this holds the lower bounds of the exclusive region.
! {\tt exclusiveLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
!\item[{[exclusiveUBound]}]
! Upon return this holds the upper bounds of the exclusive region.
! {\tt exclusiveUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
!\item[{[exclusiveCount]}]
! Upon return this holds the number of items, {\tt exclusiveUBound-exclusiveLBound+1},
! in the exclusive region per dimension.
! {\tt exclusiveCount} must
! be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
!\item[{[computationalLBound]}]
! Upon return this holds the lower bounds of the stagger region.
! {\tt computationalLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
!\item[{[computationalUBound]}]
! Upon return this holds the upper bounds of the stagger region.
! {\tt computationalUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
!\item[{[computationalCount]}]
! Upon return this holds the number of items in the computational region per dimension
! (i.e. {\tt computationalUBound-computationalLBound+1}). {\tt computationalCount}
! must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
!\item[{[totalLBound]}]
! Upon return this holds the lower bounds of the total region.
! {\tt totalLBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
!\item[{[totalUBound]}]
! Upon return this holds the upper bounds of the total region.
! {\tt totalUBound} must be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
!\item[{[totalCount]}]
! \begin{sloppypar}
! Upon return this holds the number of items in the total region per dimension
! (i.e. {\tt totalUBound-totalLBound+1}). {\tt totalCount} must
! be allocated to be of size equal to the item dimCount.
! Please see Section~\ref{sec:grid:usage:bounds} for a description
! of the regions and their associated bounds and counts.
! \end{sloppypar}
!\item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
!\end{description}
!
!EOP
integer :: localrc ! local error status
type(ESMF_InterArray) :: exclusiveLBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveUBoundArg ! helper variable
type(ESMF_InterArray) :: exclusiveCountArg ! helper variable
type(ESMF_InterArray) :: computationalLBoundArg ! helper variable
type(ESMF_InterArray) :: computationalUBoundArg ! helper variable
type(ESMF_InterArray) :: computationalCountArg ! helper variable
type(ESMF_InterArray) :: totalLBoundArg ! helper variable
type(ESMF_InterArray) :: totalUBoundArg ! helper variable
type(ESMF_InterArray) :: totalCountArg ! helper variable
integer :: tmp_staggerloc
! 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_GridGetInit, grid, rc)
! handle staggerloc
if (present(staggerloc)) then
tmp_staggerloc=staggerloc%staggerloc
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc ! default
endif
! process optional arguments
exclusiveLBoundArg=ESMF_InterArrayCreate(exclusiveLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveUBoundArg=ESMF_InterArrayCreate(exclusiveUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
exclusiveCountArg=ESMF_InterArrayCreate(exclusiveCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalLBoundArg=ESMF_InterArrayCreate(computationalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalUBoundArg=ESMF_InterArrayCreate(computationalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
computationalCountArg=ESMF_InterArrayCreate(computationalCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalLBoundArg=ESMF_InterArrayCreate(totalLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalUBoundArg = ESMF_InterArrayCreate(totalUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
totalCountArg = ESMF_InterArrayCreate(totalCount, 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_GridGetItemBounds(grid, localDE, tmp_staggerloc, itemflag, &
exclusiveLBoundArg, exclusiveUBoundArg, exclusiveCountArg, &
computationalLBoundArg, computationalUBoundArg, computationalCountArg,&
totalLBoundArg, totalUBoundArg, totalCountArg, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate interface ints
call ESMF_InterArrayDestroy(exclusiveLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(exclusiveCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(computationalCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalUBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(totalCountArg, 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_GridGetItemBounds
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridSerialize"
!BOPI
! !IROUTINE: ESMF_GridSerialize - Serialize grid info into a byte stream
!
! !INTERFACE:
subroutine ESMF_GridSerialize(grid, buffer, length, offset, &
attreconflag, inquireflag, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(inout) :: grid
character, pointer, dimension(:) :: buffer
integer, intent(inout) :: length
integer, intent(inout) :: offset
type(ESMF_AttReconcileFlag), intent(in), optional :: attreconflag
type(ESMF_InquireFlag), intent(in), optional :: inquireflag
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! Takes an {\tt ESMF\_Grid} object and adds all the information needed
! to recreate the object based on this information.
! Expected to be used by {\tt ESMF\_StateReconcile()}.
!
! The arguments are:
! \begin{description}
! \item [grid]
! {\tt ESMF\_Grid} object to be serialized.
! \item [buffer]
! Data buffer which will hold the serialized information.
! \item [length]
! Current length of buffer, in bytes. If the serialization
! process needs more space it will allocate it and update
! this length.
! \item [offset]
! Current write offset in the current buffer. This will be
! updated by this routine and return pointing to the next
! available byte in the buffer.
! \item[{[attreconflag]}]
! Flag to tell if Attribute serialization is to be done
! \item[{[inquireflag]}]
! Flag to tell if serialization is to be done (ESMF_NOINQUIRE)
! or if this is simply a size inquiry (ESMF_INQUIREONLY)
! \item [{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
integer :: localrc
type(ESMF_AttReconcileFlag) :: lattreconflag
type(ESMF_InquireFlag) :: linquireflag
! Initialize
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! check variables
ESMF_INIT_CHECK_DEEP(ESMF_GridGetInit,grid,rc)
! deal with optional attreconflag and inquireflag
if (present(attreconflag)) then
lattreconflag = attreconflag
else
lattreconflag = ESMF_ATTRECONCILE_OFF
endif
if (present (inquireflag)) then
linquireflag = inquireflag
else
linquireflag = ESMF_NOINQUIRE
end if
call c_ESMC_GridSerialize(grid, buffer, length, offset, &
lattreconflag, linquireflag, localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! return success
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridSerialize
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridDeserialize"
!BOPI
! !IROUTINE: ESMF_GridDeserialize - Deserialize a byte stream into a Grid
!
! !INTERFACE:
function ESMF_GridDeserialize(buffer, offset, &
attreconflag, rc)
!
! !RETURN VALUE:
type(ESMF_Grid) :: ESMF_GridDeserialize
!
! !ARGUMENTS:
character, pointer, dimension(:) :: buffer
integer, intent(inout) :: offset
type(ESMF_AttReconcileFlag), optional :: attreconflag
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! Takes a byte-stream buffer and reads the information needed to
! recreate a Grid object. Recursively calls the deserialize routines
! needed to recreate the subobjects.
! Expected to be used by {\tt ESMF\_StateReconcile()}.
!
! The arguments are:
! \begin{description}
! \item [buffer]
! Data buffer which holds the serialized information.
! \item [offset]
! Current read offset in the current buffer. This will be
! updated by this routine and return pointing to the next
! unread byte in the buffer.
! \item[{[attreconflag]}]
! Flag to tell if Attribute serialization is to be done
! \item [{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
integer :: localrc
type(ESMF_Grid) :: grid
type(ESMF_AttReconcileFlag) :: lattreconflag
! Initialize
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! deal with optional attreconflag
if (present(attreconflag)) then
lattreconflag = attreconflag
else
lattreconflag = ESMF_ATTRECONCILE_OFF
endif
! Call into C++ to Deserialize the Grid
call c_ESMC_GridDeserialize(grid%this, buffer, offset, &
lattreconflag, localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set return value
ESMF_GridDeserialize = grid
! Set init status
ESMF_INIT_SET_CREATED(ESMF_GridDeserialize)
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridDeserialize
! -------------------------- ESMF-public method -------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridIsCreated()"
!BOP
! !IROUTINE: ESMF_GridIsCreated - Check whether a Grid object has been created
! !INTERFACE:
function ESMF_GridIsCreated(grid, keywordEnforcer, rc)
! !RETURN VALUE:
logical :: ESMF_GridIsCreated
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(out), optional :: rc
! !DESCRIPTION:
! Return {\tt .true.} if the {\tt grid} has been created. Otherwise return
! {\tt .false.}. If an error occurs, i.e. {\tt rc /= ESMF\_SUCCESS} is
! returned, the return value of the function will also be {\tt .false.}.
!
! The arguments are:
! \begin{description}
! \item[grid]
! {\tt ESMF\_Grid} queried.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
!-----------------------------------------------------------------------------
ESMF_GridIsCreated = .false. ! initialize
if (present(rc)) rc = ESMF_SUCCESS
if (ESMF_GridGetInit(grid)==ESMF_INIT_CREATED) &
ESMF_GridIsCreated = .true.
end function
!------------------------------------------------------------------------------
! -------------------------- ESMF-public method -------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridMatch()"
!BOP
! !IROUTINE: ESMF_GridMatch - Check if two Grid objects match
! !INTERFACE:
function ESMF_GridMatch(grid1, grid2, keywordEnforcer, globalflag, rc)
!
! !RETURN VALUE:
type(ESMF_GridMatch_Flag) :: ESMF_GridMatch
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid1
type(ESMF_Grid), intent(in) :: grid2
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
logical, intent(in), optional :: globalflag
integer, intent(out), optional :: rc
!
!
! !DESCRIPTION:
! Check if {\tt grid1} and {\tt grid2} match. Returns a range of values of type
! ESMF\_GridMatch indicating how closely the Grids match. For a description of
! the possible return values, please see~\ref{const:gridmatch}.
! Please also note that by default this call is not collective and only
! returns the match for the piece of the Grids on the local PET. In this case,
! it is possible for this call to return a different match on different PETs
! for the same Grids. To do a global match operation set the {\tt globalflag}
! argument to .true.. In this case, the call becomes collective across the
! current VM, ensuring the same result is returned on all PETs.
!
! The arguments are:
! \begin{description}
! \item[grid1]
! {\tt ESMF\_Grid} object.
! \item[grid2]
! {\tt ESMF\_Grid} object.
! \item[{[globalflag]}]
! By default this flag is set to false. When it's set to true, the
! function performs the match check globally. In this case,
! the method becomes collective across the current VM.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
!------------------------------------------------------------------------------
integer :: localrc ! local return code
integer :: matchResult
integer(ESMF_KIND_I4) :: localResult(1), globalResult(1)
logical :: l_global
integer :: npet
type(ESMF_VM) :: vm
! initialize return code; assume routine not implemented
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! init to one setting in case of error
ESMF_GridMatch = ESMF_GRIDMATCH_INVALID
! Check init status of arguments
ESMF_INIT_CHECK_DEEP(ESMF_GridGetInit, grid1, rc)
ESMF_INIT_CHECK_DEEP(ESMF_GridGetInit, grid2, rc)
! Call into the C++ interface, which will sort out optional arguments.
call c_ESMC_GridMatch(grid1, grid2, matchResult, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (matchResult == 1) then
ESMF_GridMatch = ESMF_GRIDMATCH_EXACT
else
ESMF_GridMatch = ESMF_GRIDMATCH_NONE
endif
l_global = .false.
if(present(globalflag)) l_global = globalflag
if(l_global) then
call ESMF_VMGetCurrent(vm, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_VMGet(vm, petCount=npet, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
localResult(1) = matchResult
globalResult(1) = 0
call ESMF_VMAllReduce(vm, localResult, globalResult, &
1, ESMF_REDUCE_SUM, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if(globalResult(1) == npet) then
ESMF_GridMatch = ESMF_GRIDMATCH_EXACT
else
ESMF_GridMatch = ESMF_GRIDMATCH_NONE
endif
endif
! return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridMatch
!------------------------------------------------------------------------------
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridPrint"
!BOPI
! !IROUTINE: ESMF_GridPrint - Print interesting values in a Grid
! !INTERFACE
subroutine ESMF_GridPrint (grid, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! Print interesting values in a Grid.
!
! The arguments are:
! \begin{description}
! \item[{grid}]
! Grid to print.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
integer :: localrc ! local error status
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! check input variables
call ESMF_InitPrint (ESMF_INIT_GET(grid))
ESMF_INIT_CHECK_DEEP(ESMF_GridGetInit, grid, rc)
call ESMF_UtilIOUnitFlush (unit=ESMF_UtilIOstdout, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Just print its base for now
call c_ESMC_BasePrint(grid, 0, "debug", ESMF_FALSE, "", ESMF_FALSE, localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present (rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridPrint
!------------------------------------------------------------------------------
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridRedist"
!BOP
! !IROUTINE: ESMF_GridRedist - Redistribute the coordinates of a Grid
! !INTERFACE:
subroutine ESMF_GridRedist(srcGrid, dstGrid, routehandle, keywordEnforcer, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: srcGrid
type(ESMF_Grid), intent(inout) :: dstGrid
type(ESMF_RouteHandle),intent(inout) :: routehandle
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This call is companion to the {\tt ESMF\_GridCreate()} that allows the user to copy an
! existing ESMF Grid, but with a new distribution. The {\tt ESMF\_GridRedist()} allows
! the user to repeatedly redistribute the coordinates from {\tt srcGrid} to {\tt dstGrid}.
!
! The arguments are:
! \begin{description}
! \item[srcGrid]
! The source grid providing the coordinates.
! \item[srcGrid]
! The destination grid receiving the coordinates from {\tt srcGrid}.
! \item[routehandle]
! The {\tt ESMF\_RouteHandle} object returned by the companion method
! {\tt ESMF\_GridCreate()} used to create {\tt dstGrid} from {\tt srcGrid}.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
integer :: localrc
type(ESMF_ArrayBundle) :: srcAB, dstAB
integer :: i, j, nStaggers
integer :: rank, dimCount, maxNumStaggers
logical, allocatable :: srcRepl(:), dstRepl(:)
type(ESMF_STAGGERLOC), allocatable :: staggers(:)
type(ESMF_Array), allocatable :: srcA(:), dstA(:)
type(ESMF_Array), allocatable :: srcA2D(:), dstA2D(:)
integer :: arrayDimCount
integer :: localDECount, localDE
integer :: atodMap(1), k
type(ESMF_DistGrid) :: dg
type(ESMF_TypeKind_Flag) :: tk
type(ESMF_Index_Flag) :: arrayIndexflag
real(ESMF_KIND_R8), pointer:: farrayPtr(:), farrayPtr2d(:,:)
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check init status of arguments
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, srcGrid, rc)
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, dstGrid, rc)
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_RouteHandleGetInit, routehandle, rc)
call ESMF_GridGet(srcGrid, dimCount=dimCount, &
staggerlocCount=maxNumStaggers, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Allocate to maximum number of possible staggers
allocate(staggers(maxNumStaggers))
! Get list and number of active staggers
call c_ESMC_gridgetactivestaggers(srcGrid%this, &
nStaggers, staggers, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! prep arrays
allocate(srcA(dimCount*nStaggers), dstA(dimCount*nStaggers))
allocate(srcA2D(dimCount*nStaggers), dstA2D(dimCount*nStaggers))
allocate(srcRepl(dimCount*nStaggers), dstRepl(dimCount*nStaggers))
! Pull coord Arrays out of srcGrid
do i=1,dimCount
do j = 1, nStaggers
call ESMF_GridGetCoord(srcGrid, coordDim=i, staggerloc=staggers(j), &
array=srcA((i-1)*nStaggers+j), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
enddo
enddo
! construct temporary 2D src Arrays and fill with data if necessary
do k=1, dimCount*nStaggers
call ESMF_ArrayGet(srcA(k), rank=rank, dimCount=arrayDimCount, &
localDECount=localDECount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (rank==arrayDimCount) then
! branch that assumes no replicated dims in Array
! TODO: actually there may still be replication, only
! TODO: arrayToDistGridMap conclusively provides that indication
srcRepl(k) = .false.
srcA2D(k) = srcA(k)
else
! this branch is hard-coded for 2D DistGrids with 1D replicated
! dim Arrays along one dimension
srcRepl(k) = .true.
call ESMF_ArrayGet(srcA(k), distgrid=dg, typekind=tk, &
arrayToDistGridMap=atodMap, indexflag=arrayIndexflag, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
srcA2D(k) = ESMF_ArrayCreate(distgrid=dg, typekind=tk, &
indexflag=arrayIndexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (localDECount/=0) then
call ESMF_ArrayGet(srcA(k), farrayPtr=farrayPtr, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayGet(srcA2D(k), farrayPtr=farrayPtr2D, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (atodMap(1)==1) then
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
farrayPtr2D(i,j) = farrayPtr(i)
enddo
enddo
else
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
farrayPtr2D(i,j) = farrayPtr(j)
enddo
enddo
endif
endif
endif
enddo
! Pull coord Arrays out of dstGrid
do i=1,dimCount
do j = 1, nStaggers
call ESMF_GridGetCoord(dstGrid, coordDim=i, staggerloc=staggers(j), &
array=dstA((i-1)*nStaggers+j), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
enddo
enddo
! construct temporary 2D Arrays
do k=1, dimCount*nStaggers
call ESMF_ArrayGet(dstA(k), rank=rank, dimCount=arrayDimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (rank==arrayDimCount) then
! branch that assumes no replicated dims in Array
! TODO: actually there may still be replication, only
! TODO: arrayToDistGridMap conclusively provides that indication
dstRepl(k) = .false.
dstA2D(k) = dstA(k)
else
dstRepl(k) = .true.
call ESMF_ArrayGet(dstA(k), distgrid=dg, typekind=tk, &
indexflag=arrayIndexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
dstA2D(k) = ESMF_ArrayCreate(distgrid=dg, typekind=tk, &
indexflag=arrayIndexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
enddo
! Create ArrayBundles
srcAB = ESMF_ArrayBundleCreate(arrayList=srcA2D, multiflag=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
dstAB = ESMF_ArrayBundleCreate(arrayList=dstA2D, multiflag=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
! Redist between ArrayBundles
call ESMF_ArrayBundleRedist(srcAB, dstAB, routehandle=routehandle, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
! Destroy ArrayBundles
call ESMF_ArrayBundleDestroy(srcAB, noGarbage=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayBundleDestroy(dstAB, noGarbage=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, ESMF_CONTEXT, rcToReturn=rc)) return
! Fill the replicated dimension Arrays from the 2D redist data
do k=1, dimCount*nStaggers
if (dstRepl(k)) then
call ESMF_ArrayGet(dstA(k), arrayToDistGridMap=atodMap, &
localDECount=localDECount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
do localDE=0, localDECount-1
call ESMF_ArrayGet(dstA(k), localDE=localDE, &
farrayPtr=farrayPtr, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayGet(dstA2D(k), localDE=localDE, &
farrayPtr=farrayPtr2D, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (atodMap(1)==1) then
do i=lbound(farrayPtr2D,1), ubound(farrayPtr2D,1)
farrayPtr(i) = farrayPtr2D(i,lbound(farrayPtr2D,2))
enddo
else
do j=lbound(farrayPtr2D,2), ubound(farrayPtr2D,2)
farrayPtr(j) = farrayPtr2D(lbound(farrayPtr2D,1),j)
enddo
endif
enddo
endif
enddo
! clean up temporary Arrays
do k=1, dimCount*nStaggers
if (srcRepl(k)) then
call ESMF_ArrayDestroy(srcA2D(k), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if (dstRepl(k)) then
call ESMF_ArrayDestroy(dstA2D(k), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
enddo
deallocate(srcA)
deallocate(srcA2D)
deallocate(dstA)
deallocate(dstA2D)
deallocate(srcRepl)
deallocate(dstRepl)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridRedist
!------------------------------------------------------------------------------
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridSetFromDistGrid"
!BOPI
! !IROUTINE: ESMF_GridSet - Set the values in a Grid which has been created with EmptyCreate
! !INTERFACE:
! Private name; call using ESMF_GridSet()
subroutine ESMF_GridSetFromDistGrid(grid, keywordEnforcer, &
distgrid,distgridToGridMap, distDim, &
coordSys, coordTypeKind, coordDimCount, coordDimMap, &
minIndex, maxIndex, &
localArbIndexCount, localArbIndex, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, gridMemLBound, &
indexflag, destroyDistgrid, destroyDELayout, name, vm, rc)
!
! !RETURN VALUE:
!
! !ARGUMENTS:
type(ESMF_Grid), intent(inout) :: grid
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_DistGrid), intent(in), optional :: distgrid
integer, intent(in), optional :: distgridToGridMap(:)
integer, intent(in), optional :: distDim(:)
type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: coordDimCount(:)
integer, intent(in), optional :: coordDimMap(:,:)
integer, intent(in), optional :: minIndex(:)
integer, intent(in), optional :: maxIndex(:)
integer, intent(in), optional :: localArbIndexCount
integer, intent(in), optional :: localArbIndex(:,:)
integer, intent(in), optional :: gridEdgeLWidth(:)
integer, intent(in), optional :: gridEdgeUWidth(:)
integer, intent(in), optional :: gridAlign(:)
integer, intent(in), optional :: gridMemLBound(:)
type(ESMF_Index_Flag), intent(in), optional :: indexflag
logical, intent(in), optional :: destroyDistgrid
logical, intent(in), optional :: destroyDELayout
character (len=*), intent(in), optional :: name
type(ESMF_VM), intent(in), optional :: vm
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! Set values in a grid in preparation for committing and creating a grid. This method
! is called between {\tt ESMF\_GridEmptyCreate} and {\tt ESMF\_GridCommit}. Note that
! once a grid is committed and created it's an error to try to set values in it. Note also
! that new values overwrite old values if previously set.
!
! The arguments are:
! \begin{description}
! \item[{grid}]
! Partially created Grid to set information into.
! \item[distgrid]
! {\tt ESMF\_DistGrid} object that describes how the array is decomposed and
! distributed over DEs.
! \item[{[distgridToGridMap]}]
! List that has as dimCount elements.
! The elements map each dimension of distgrid to a dimension in the grid.
! (i.e. the values should range from 1 to dimCount). If not specified, the default
! is to map all of distgrid's dimensions against the dimensions of the
! grid in sequence.
! \item[{[coordSys]}]
! The coordinate system of the grid coordinate data.
! For a full list of options, please see Section~\ref{const:coordsys}.
! If not specified then defaults to ESMF\_COORDSYS\_SPH\_DEG.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[minIndex]}]
! Tuple to start the index ranges at. If not present, defaults
! to /1,1,1,.../.
! \item[{[maxIndex]}]
! The upper extend of the grid index ranges.
! \item[{[localArbIndex]}]
! This 2D array specifies the indices of the local grid cells. The
! dimensions should be localArbIndexCount * number of grid dimensions
! where localArbIndexCount is the input argument specified below
! \item[{localArbIndexCount}]
! number of grid cells in the local DE
! \item[{[gridEdgeLWidth]}]
! The padding around the lower edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 0, 0, ..., 0 (all zeros).
! \item[{[gridEdgeUWidth]}]
! The padding around the upper edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 1, 1, ..., 1 (all ones).
! \item[{[gridAlign]}]
! Specification of how the stagger locations should align with the cell
! index space (can be overridden by the individual staggerAligns). If
! the gridEdgeWidths are not specified than this argument
! implies the gridEdgeWidths. If the gridEdgeWidths are specified and this argument isn't
! then this argument is implied by the gridEdgeWidths.
! If this and the gridEdgeWidths are not specified, then defaults to
! -1, -1, ..., -1 (all negative ones).
! \item[{[gridMemLBound]}]
! Specifies the lower index range of the memory of every DE in this Grid.
! Only used when indexflag is {\tt ESMF\_INDEX\_USER}. May be overridden
! by staggerMemLBound.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[destroyDistgrid]}]
! If true, when the Grid is destroyed the DistGrid will be destroyed also.
! Defaults to false.
! \item[{[destroyDELayout]}]
! If true, when the Grid is destroyed the DELayout will be destroyed also.
! Defaults to false.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
integer :: localrc ! local error status
integer :: nameLen
type(ESMF_InterArray) :: gridEdgeLWidthArg ! Language Interface Helper Var
type(ESMF_InterArray) :: gridEdgeUWidthArg ! Language Interface Helper Var
type(ESMF_InterArray) :: gridAlignArg ! Language Interface Helper Var
type(ESMF_InterArray) :: gridMemLBoundArg ! Language Interface Helper Var
type(ESMF_InterArray) :: distgridToGridMapArg ! Language Interface Helper Var
type(ESMF_InterArray) :: distDimArg ! Language Interface Helper Var
type(ESMF_InterArray) :: coordDimCountArg ! Language Interface Helper Var
type(ESMF_InterArray) :: coordDimMapArg ! Language Interface Helper Var
type(ESMF_InterArray) :: minIndexArg ! Language Interface Helper Var
type(ESMF_InterArray) :: maxIndexArg ! Language Interface Helper Var
type(ESMF_InterArray) :: localArbIndexArg ! Language Interface Helper Var
integer :: intDestroyDistgrid,intDestroyDELayout
type(ESMF_Pointer) :: vmThis
logical :: actualFlag
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check init status of arguments
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_DistGridGetInit, distgrid, rc)
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, grid, rc)
! Must make sure the local PET is associated with an actual member
actualFlag = .true.
if (present(vm)) then
call ESMF_VMGetThis(vm, vmThis)
if (vmThis == ESMF_NULL_POINTER) then
actualFlag = .false. ! local PET is not for an actual member of Array
endif
endif
if (actualFlag) then
! Translate F90 arguments to C++ friendly form
!! name
nameLen=0
if (present(name)) then
nameLen=len_trim(name)
endif
!! coordTypeKind
! It doesn't look like it needs to be translated, but test to make sure
!! gridEdgeLWidth and gridEdgeUWidth
gridEdgeLWidthArg = ESMF_InterArrayCreate(gridEdgeLWidth, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
gridEdgeUWidthArg = ESMF_InterArrayCreate(gridEdgeUWidth, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
gridAlignArg = ESMF_InterArrayCreate(gridAlign, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
gridMemLBoundArg = ESMF_InterArrayCreate(gridMemLBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! distgridToGridMap
distgridToGridMapArg = ESMF_InterArrayCreate(distgridToGridMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! distDim
distDimArg = ESMF_InterArrayCreate(distDim, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! Description of array factorization
coordDimCountArg = ESMF_InterArrayCreate(coordDimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
coordDimMapArg = ESMF_InterArrayCreate(farray2D=coordDimMap, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! Index bound and localArbIndex array
minIndexArg = ESMF_InterArrayCreate(minIndex, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
maxIndexArg = ESMF_InterArrayCreate(maxIndex, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
localArbIndexArg = ESMF_InterArrayCreate(farray2D=localArbIndex, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! default to don't destroy, actual value can be set by subroutine in other creates
intDestroyDistgrid=0
intDestroyDELayout=0
! Call C++ Subroutine to do the create
call c_ESMC_gridsetfromdistgrid(grid%this, nameLen, name, &
coordTypeKind, distgrid, &
distgridToGridMapArg, distDimArg, &
coordSys, coordDimCountArg, coordDimMapArg, &
minIndexArg, maxIndexArg, localArbIndexArg, localArbIndexCount, &
gridEdgeLWidthArg, gridEdgeUWidthArg, gridAlignArg, &
gridMemLBoundArg, indexflag, intDestroyDistGrid, intDestroyDELayout, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate helper variables
call ESMF_InterArrayDestroy(gridEdgeUWidthArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(gridEdgeLWidthArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(gridAlignArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(gridMemLBoundArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(distgridToGridMapArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(distDimArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(coordDimCountArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(coordDimMapArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(minIndexArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(maxIndexArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(localArbIndexArg, 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_GridSetFromDistGrid
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridSetCoordFromArray"
!BOP
! !IROUTINE: ESMF_GridSetCoord - Set coordinates using Arrays
! !INTERFACE:
subroutine ESMF_GridSetCoordFromArray(grid, coordDim, staggerloc, &
array, keywordEnforcer, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
integer, intent(in) :: coordDim
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
type(ESMF_Array), intent(in) :: array
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \end{itemize}
!
! !DESCRIPTION:
! This method sets the passed in Array as the holder of the coordinate
! data for stagger location staggerloc and coordinate coord. This method
! can be used in place of ESMF\_GridAddCoord(). In fact, if the Grid
! location already contains an Array for this coordinate, then this one
! replaces it. For this method to replace ESMF\_GridAddCoord() and produce
! a valid set of coordinates, then this method must be used to set
! an Array for each coordDim ranging from 1 to the dimCount of the passed in Grid.
!
! The arguments are:
!\begin{description}
!\item[grid]
! The grid to set the coord in.
!\item[coordDim]
! The coordinate dimension to put the data in (e.g. 1=x).
!\item[{[staggerloc]}]
! The stagger location into which to copy the arrays.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
!\item[array]
! An array to set the grid coordinate information from.
!\item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
!\end{description}
!
!EOP
integer :: tmp_staggerloc
integer :: localrc ! local error status
type(ESMF_GridDecompType) :: decompType
type(ESMF_DataCopy_Flag) :: datacopyflag
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check init status of arguments
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_ArrayGetInit, array, rc)
! ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, grid, rc)
call ESMF_GridGetDecompType(grid, decompType, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! handle staggerloc
if (present(staggerloc)) then
if ((decompType == ESMF_GRID_ARBITRARY) .and. &
(staggerloc /= ESMF_STAGGERLOC_CENTER)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- staggerloc has to be ESMF_STAGGERLOC_CENTER for arbitrary grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
else
tmp_staggerloc=staggerloc%staggerloc
endif
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc
endif
! Use reference
datacopyflag=ESMF_DATACOPY_REFERENCE
! Call C++ Subroutine to do the create
call c_ESMC_gridsetcoordfromarray(grid%this,tmp_staggerloc, coordDim, &
array, datacopyflag, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridSetCoordFromArray
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridSetCmmitShapeTileIrreg"
!BOPI
! !IROUTINE: ESMF_GridSetCommitShapeTile - Set and complete a Grid with an irregular distribution
! !INTERFACE:
! Private name; call using ESMF_GridSetCommitShapeTile()
subroutine ESMF_GridSetCmmitShapeTileIrreg(grid, name,coordTypeKind, &
minIndex, countsPerDEDim1, countsPerDeDim2, &
keywordEnforcer, countsPerDEDim3, connflagDim1, connflagDim2, connflagDim3, &
poleStaggerLoc1, poleStaggerLoc2, poleStaggerLoc3, &
bipolePos1, bipolePos2, bipolePos3, &
coordDep1, coordDep2, coordDep3, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridMemLBound, indexflag, petMap, rc)
!
! !ARGUMENTS:
type (ESMF_Grid) :: grid
character (len=*), intent(in), optional :: name
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: countsPerDEDim1(:)
integer, intent(in) :: countsPerDEDim2(:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(in), optional :: countsPerDEDim3(:)
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim1(:) !N. IMP.
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim2(:) !N. IMP.
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim3(:) !N. IMP.
type(ESMF_StaggerLoc),intent(in),optional::poleStaggerLoc1(2)!N. IMP.
type(ESMF_StaggerLoc),intent(in),optional::poleStaggerLoc2(2)!N. IMP.
type(ESMF_StaggerLoc),intent(in),optional::poleStaggerLoc3(2)!N. IMP.
integer, intent(in), optional :: bipolePos1(2)!N. IMP.
integer, intent(in), optional :: bipolePos2(2)!N. IMP.
integer, intent(in), optional :: bipolePos3(2)!N. IMP.
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(in), optional :: gridEdgeLWidth(:)
integer, intent(in), optional :: gridEdgeUWidth(:)
integer, intent(in), optional :: gridAlign(:)
integer, intent(in), optional :: gridMemLBound(:)
type(ESMF_Index_Flag), intent(in), optional :: indexflag
integer, intent(in), optional :: petMap(:,:,:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method sets information into an empty Grid and then commits it to
! create a single tile, irregularly distributed grid
! (see Figure \ref{fig:GridDecomps}).
! To specify the irregular distribution, the user passes in an array
! for each grid dimension, where the length of the array is the number
! of DEs in the dimension. Up to three dimensions can be specified,
! using the countsPerDEDim1, countsPerDEDim2, countsPerDEDim3 arguments.
! The index of each array element corresponds to a DE number. The
! array value at the index is the number of grid cells on the DE in
! that dimension. The dimCount of the grid is equal to the number of
! countsPerDEDim arrays that are specified.
!
! Section \ref{example:2DIrregUniGrid} shows an example
! of using this method to create a 2D Grid with uniformly spaced
! coordinates. This creation method can also be used as the basis for
! grids with rectilinear coordinates or curvilinear coordinates.
!
! For consistency's sake the {\tt ESMF\_GridSetCommitShapeTile()} call
! should be executed in the same set or a subset of the PETs in which the
! {\tt ESMF\_GridEmptyCreate()} call was made. If the call
! is made in a subset, the Grid objects outside that subset will
! still be "empty" and not usable.
!
! The arguments are:
! \begin{description}
! \item[{grid}]
! The empty {\tt ESMF\_Grid} to set information into and then commit.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[minIndex]}]
! Tuple to start the index ranges at. If not present, defaults
! to /1,1,1,.../.
! \item[{countsPerDEDim1}]
! This arrays specifies the number of cells per DE for index dimension 1
! for the exclusive region (the center stagger location).
! If the array has only one entry, then the dimension is undistributed.
! \item[{countsPerDEDim2}]
! This array specifies the number of cells per DE for index dimension 2
! for the exclusive region (center stagger location).
! If the array has only one entry, then the dimension is undistributed.
! \item[{[countsPerDEDim3]}]
! This array specifies the number of cells per DE for index dimension 3
! for the exclusive region (center stagger location).
! If not specified then grid is 2D. Also, If the array has only one entry,
! then the dimension is undistributed.
! \item[{[connflagDim1]}]
! Fortran array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[connflagDim2]}]
! Fortran array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[connflagDim3]}]
! Fortran array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[poleStaggerLoc1]}]
! Two element array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If a pole, this describes which staggerlocation is at the pole at each end.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[poleStaggerLoc2]}]
! Two element array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If a pole, this describes which staggerlocation is at the pole at each end.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[poleStaggerLoc3]}]
! Two element array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If a pole, this describes which staggerlocation is at the pole at each end.
! If not present, the default is the edge.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[bipolePos1]}]
! Two element array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If a bipole, this gives the index position of one of the poles.
! The other is half way around. If not present, the default is 1.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[bipolePos2]}]
! Two element array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If a bipole, this gives the index position of one of the poles.
! The other is half way around. If not present, the default is 1.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[bipolePos3]}]
! Two element array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If a bipole, this gives the index position of one of the poles.
! The other is half way around. If not present, the default is 1.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[coordDep1]}]
! This array specifies the dependence of the first
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the first
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep2]}]
! This array specifies the dependence of the second
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the second
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep3]}]
! This array specifies the dependence of the third
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the third
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[gridEdgeLWidth]}]
! The padding around the lower edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 0, 0, ..., 0 (all zeros).
! \item[{[gridEdgeUWidth]}]
! The padding around the upper edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 1, 1, ..., 1 (all ones).
! \item[{[gridAlign]}]
! Specification of how the stagger locations should align with the cell
! index space (can be overridden by the individual staggerAligns). If
! the gridEdgeWidths are not specified than this argument
! implies the gridEdgeWidths. If the gridEdgeWidths are specified and this argument isn't
! then this argument is implied by the gridEdgeWidths.
! If this and the gridEdgeWidths are not specified, then defaults to
! -1, -1, ..., -1 (all negative ones).
! \item[{[gridMemLBound]}]
! Specifies the lower index range of the memory of every DE in this Grid.
! Only used when indexflag is {\tt ESMF\_INDEX\_USER}. May be overridden
! by staggerMemLBound.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[petMap]}]
! \begin{sloppypar}
! Sets the mapping of pets to the created DEs. This 3D
! should be of size size(countsPerDEDim1) x size(countsPerDEDim2) x
! size(countsPerDEDim3). If countsPerDEDim3 isn't present, then
! the last dimension is of size 1.
! \end{sloppypar}
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
type(ESMF_DistGrid) :: distgrid
type(ESMF_DELayout) :: delayout
integer, pointer :: petList(:)
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer :: localrc
integer :: dimCount,i,maxSizeDEDim
integer, pointer :: distgridToGridMap(:), deDimCount(:)
integer, pointer :: minIndexLocal(:)
integer, pointer :: maxIndexLocal(:)
integer, pointer :: gridEdgeLWidthLocal(:)
integer, pointer :: gridEdgeUWidthLocal(:)
integer, pointer :: gridAlignLocal(:)
integer, pointer :: countsPerDEDim1Local(:)
integer, pointer :: countsPerDEDim2Local(:)
integer, pointer :: countsPerDEDim3Local(:)
integer, pointer :: deBlockList(:,:,:),minPerDEDim(:,:),maxPerDEDim(:,:)
integer :: deCount
integer :: d,i1,i2,i3,k
type(ESMF_GridConn_Flag) :: connflagDim1Local(2)
type(ESMF_GridConn_Flag) :: connflagDim2Local(2)
type(ESMF_GridConn_Flag) :: connflagDim3Local(2)
integer :: connCount, petListCount
integer :: top
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Compute the Grid DimCount and Derivatives ---------------------------------------------------
! dimCount
if (present(countsPerDEDim3)) then
dimCount=3
else
dimCount=2
endif
! Argument Consistency Checking --------------------------------------------------------------
if (size(countsPerDEDim1) .lt. 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- size 0 countsPerDEDim1 not allowed", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (size(countsPerDEDim2) .lt. 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- size 0 countsPerDEDim2 not allowed", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (present(countsPerDEDim3)) then
if (size(countsPerDEDim3) .lt. 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- size 0 countsPerDEDim3 not allowed", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if ((dimCount .lt. 3) .and. present(connflagDim3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- connflagDim3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((dimCount .lt. 3) .and. present(poleStaggerLoc3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- poleStaggerLoc3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((dimCount .lt. 3) .and. present(bipolePos3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- bipolePos3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((dimCount .lt. 3) .and. present(coordDep3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- coordDep3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (present(coordDep1)) then
if ((size(coordDep1) < 1) .or. (size(coordDep1)>dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- coordDep1 size incompatible with grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(coordDep2)) then
if ((size(coordDep2) < 1) .or. (size(coordDep2)>dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- coordDep2 size incompatible with grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(coordDep3)) then
if ((size(coordDep3) < 1) .or. (size(coordDep3)>dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- coordDep3 size incompatible with grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(minIndex)) then
if (size(minIndex) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- minIndex size must equal grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(petMap)) then
if (dimCount > 2) then
if ((size(petMap,1) /= size(countsPerDEDim1)) .or. &
(size(petMap,2) /= size(countsPerDEDim2)) .or. &
(size(petMap,3) /= size(countsPerDEDim3))) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- petMap wrong size in one or more dimensions", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else
if ((size(petMap,1) /= size(countsPerDEDim1)) .or. &
(size(petMap,2) /= size(countsPerDEDim2)) .or. &
(size(petMap,3) /= 1)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- petMap wrong size in one or more dimensions", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
! Check DimCount of gridWidths and Aligns
if (present(gridEdgeLWidth)) then
if (size(gridEdgeLWidth) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridEdgeLWidth must be of size equal to Grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridEdgeUWidth)) then
if (size(gridEdgeUWidth) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridEdgeUWidth must be of size equal to Grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridAlign)) then
if (size(gridAlign) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridAlign must be of size equal to Grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! make sure connected dimensions don't have an edge width
if (present(connflagDim1)) then
if (size(connflagDim1) == 1) then
if (connflagDim1(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(1) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(1) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
else if (size(connflagDim1) == 2) then
if (connflagDim1(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(1) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
if (connflagDim1(2) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(1) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
endif
endif
! make sure connected dimensions don't have an edge width
if (present(connflagDim2)) then
if (size(connflagDim2) == 1) then
if (connflagDim2(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(2) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(2) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
else if (size(connflagDim2) == 2) then
if (connflagDim2(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(2) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
if (connflagDim2(2) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(2) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
endif
endif
! make sure connected dimensions don't have an edge width
if (present(connflagDim3)) then
if (size(connflagDim3) == 1) then
if (connflagDim3(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(3) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(3) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
else if (size(connflagDim3) == 2) then
if (connflagDim3(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(3) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
if (connflagDim3(2) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(3) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
endif
endif
! check for gridMemLBound issues
if (present(gridMemLBound)) then
if (.not. present(indexflag)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- when using gridMemLBound must specify indexflag=ESMF_INDEX_USER ", &
ESMF_CONTEXT, rcToReturn=rc)
return
else if (.not. (indexflag == ESMF_INDEX_USER)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- when using gridMemLBound must specify indexflag=ESMF_INDEX_USER ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else
if (present(indexflag)) then
if (indexflag == ESMF_INDEX_USER) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- when using indexflag=ESMF_INDEX_USER must provide gridMemLBound ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
! Check for non-valid connection types here
!TODO: Consider making some of these a separate local subroutine (particularly if you're going to
! have 3 of these ShapeCreate subroutines with only minor changes
! Copy vales for countsPerDEDim --------------------------------------------
allocate(countsPerDEDim1Local(size(countsPerDEDim1)), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
countsPerDEDim1Local=countsPerDEDim1
allocate(countsPerDEDim2Local(size(countsPerDEDim2)), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
countsPerDEDim2Local=countsPerDEDim2
if (dimCount > 2) then
allocate(countsPerDEDim3Local(size(countsPerDEDim3)), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
countsPerDEDim3Local=countsPerDEDim3
endif
! Set Defaults -------------------------------------------------------------
! Set default for minIndex
allocate(minIndexLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(minIndex)) then
minIndexLocal(:)=minIndex(:)
else
do i=1,dimCount
minIndexLocal(i)=1
enddo
endif
! Set Default for connections (although they don't work yet in distgrid/array, so they aren't really used anywhere yet.)
if (present(connflagDim1)) then
if (size(connflagDim1) == 1) then
connflagDim1Local(1)=connflagDim1(1)
connflagDim1Local(2)=connflagDim1(1) ! if only 1 connection is specified then repeat for both ends
else if (size(connflagDim1) >= 2) then
connflagDim1Local(1)=connflagDim1(1)
connflagDim1Local(2)=connflagDim1(2)
endif
else
connflagDim1Local(1)=ESMF_GRIDCONN_NONE ! if not present then default to no connection
connflagDim1Local(2)=ESMF_GRIDCONN_NONE
endif
if (present(connflagDim2)) then
if (size(connflagDim2) == 1) then
connflagDim2Local(1)=connflagDim2(1)
connflagDim2Local(2)=connflagDim2(1) ! if only 1 connection is specified then repeat for both ends
else if (size(connflagDim2) >= 2) then
connflagDim2Local(1)=connflagDim2(1)
connflagDim2Local(2)=connflagDim2(2)
endif
else
connflagDim2Local(1)=ESMF_GRIDCONN_NONE ! if not present then default to no connection
connflagDim2Local(2)=ESMF_GRIDCONN_NONE
endif
if (present(connflagDim3)) then
if (size(connflagDim3) == 1) then
connflagDim3Local(1)=connflagDim3(1)
connflagDim3Local(2)=connflagDim3(1) ! if only 1 connection is specified then repeat for both ends
else if (size(connflagDim3) >= 2) then
connflagDim3Local(1)=connflagDim3(1)
connflagDim3Local(2)=connflagDim3(2)
endif
else
connflagDim3Local(1)=ESMF_GRIDCONN_NONE ! if not present then default to no connection
connflagDim3Local(2)=ESMF_GRIDCONN_NONE
endif
! check for not implemented functionality
if (connflagDim1Local(1) /= ESMF_GRIDCONN_NONE .or. &
connflagDim1Local(2) /= ESMF_GRIDCONN_NONE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- Only ESMF_GRIDCONN_NONE Grid connection implemented so far", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (connflagDim2Local(1) /= ESMF_GRIDCONN_NONE .or. &
connflagDim2Local(2) /= ESMF_GRIDCONN_NONE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- Only ESMF_GRIDCONN_NONE Grid connection implemented so far", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (connflagDim3Local(1) /= ESMF_GRIDCONN_NONE .or. &
connflagDim3Local(2) /= ESMF_GRIDCONN_NONE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- Only ESMF_GRIDCONN_NONE Grid connection implemented so far", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Make alterations to size due to GridEdgeWidths ----------------------------
allocate(gridEdgeLWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeLWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridEdgeUWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeUWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridAlignLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridAlignLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridLUADefault(dimCount, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridEdgeLWidthLocal, gridEdgeUWidthLocal, gridAlignLocal, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
#if 0
! Modify lower bound
do i=1,dimCount
minIndexLocal(i)=minIndexLocal(i)-gridEdgeLWidthLocal(i)
enddo
! Modify lower size
countsPerDEDim1Local(1)=countsPerDEDim1Local(1)+gridEdgeLWidthLocal(1)
countsPerDEDim2Local(1)=countsPerDEDim2Local(1)+gridEdgeLWidthLocal(2)
if (dimCount > 2) then
countsPerDEDim3Local(1)=countsPerDEDim3Local(1)+gridEdgeLWidthLocal(3)
endif
! Modify upper size
top=size(countsPerDEDim1Local)
countsPerDEDim1Local(top)=countsPerDEDim1Local(top)+gridEdgeUWidthLocal(1)
top=size(countsPerDEDim2Local)
countsPerDEDim2Local(top)=countsPerDEDim2Local(top)+gridEdgeUWidthLocal(2)
if (dimCount > 2) then
top=size(countsPerDEDim3Local)
countsPerDEDim3Local(top)=countsPerDEDim3Local(top)+gridEdgeUWidthLocal(3)
endif
#endif
! Calc minIndex,maxIndex,distgridToGridMap for DistGrid -----------------------------------
! Set default for maxIndex
allocate(maxIndexLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
maxIndexLocal(1)=sum(countsPerDEDim1Local)+minIndexLocal(1)-1
maxIndexLocal(2)=sum(countsPerDEDim2Local)+minIndexLocal(2)-1
if (dimCount > 2) then
maxIndexLocal(3)=sum(countsPerDEDim3Local)+minIndexLocal(3)-1
endif
allocate(distgridToGridMap(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating distgridToGridMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
do i=1,dimCount
distgridToGridMap(i)=i
enddo
! Setup deBlockList for DistGrid ------------------------------------------------
! count de blocks
deCount=1
deCount=deCount*size(countsPerDEDim1Local)
deCount=deCount*size(countsPerDEDim2Local)
if (dimCount > 2) then
deCount=deCount*size(countsPerDEDim3Local)
endif
! Calc the max size of a DEDim
maxSizeDEDim=1
if (size(countsPerDEDim1Local) > maxSizeDEDim) then
maxSizeDEDim=size(countsPerDEDim1Local)
endif
if (size(countsPerDEDim2Local) > maxSizeDEDim) then
maxSizeDEDim=size(countsPerDEDim2Local)
endif
if (dimCount > 2) then
if (size(countsPerDEDim3Local) > maxSizeDEDim) then
maxSizeDEDim=size(countsPerDEDim3Local)
endif
endif
! generate deblocklist
allocate(maxPerDEDim(dimCount,maxSizeDEDim), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxPerDEDim", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(minPerDEDim(dimCount,maxSizeDEDim), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minPerDEDim", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(deDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxPerDEDim", &
ESMF_CONTEXT, rcToReturn=rc)) return
! Calc the maximum end of each DE in a Dim, and the size of each DEDim
d=1
deDimCount(d)=size(countsPerDEDim1Local)
minPerDeDim(d,1)=minIndexLocal(d)
maxPerDeDim(d,1)=minIndexLocal(d)+countsPerDEDim1Local(1)-1
do i=2,deDimCount(d)
minPerDEDim(d,i)=maxPerDEDim(d,i-1)+1
maxPerDEDim(d,i)=minPerDEDim(d,i)+countsPerDEDim1Local(i)-1
enddo
d=2
deDimCount(d)=size(countsPerDEDim2Local)
minPerDeDim(d,1)=minIndexLocal(d)
maxPerDeDim(d,1)=minIndexLocal(d)+countsPerDEDim2Local(1)-1
do i=2,deDimCount(d)
minPerDEDim(d,i)=maxPerDEDim(d,i-1)+1
maxPerDEDim(d,i)=minPerDEDim(d,i)+countsPerDEDim2Local(i)-1
enddo
if (dimCount > 2) then
d=3
deDimCount(d)=size(countsPerDEDim3Local)
minPerDeDim(d,1)=minIndexLocal(d)
maxPerDeDim(d,1)=minIndexLocal(d)+countsPerDEDim3Local(1)-1
do i=2,deDimCount(d)
minPerDEDim(d,i)=maxPerDEDim(d,i-1)+1
maxPerDEDim(d,i)=minPerDEDim(d,i)+countsPerDEDim3Local(i)-1
enddo
endif
! allocate deblocklist
allocate(deBlockList(dimCount,2,deCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating deBlockList", &
ESMF_CONTEXT, rcToReturn=rc)) return
! Fill in DeBlockList
if (dimCount == 2) then
k=1
do i2=1,deDimCount(2)
do i1=1,deDimCount(1)
deBlockList(1,1,k)=minPerDEDim(1,i1)
deBlockList(1,2,k)=maxPerDEDim(1,i1)
deBlockList(2,1,k)=minPerDEDim(2,i2)
deBlockList(2,2,k)=maxPerDEDim(2,i2)
k=k+1
enddo
enddo
else if (dimCount == 3) then
k=1
do i3=1,deDimCount(3)
do i2=1,deDimCount(2)
do i1=1,deDimCount(1)
deBlockList(1,1,k)=minPerDEDim(1,i1)
deBlockList(1,2,k)=maxPerDEDim(1,i1)
deBlockList(2,1,k)=minPerDEDim(2,i2)
deBlockList(2,2,k)=maxPerDEDim(2,i2)
deBlockList(3,1,k)=minPerDEDim(3,i3)
deBlockList(3,2,k)=maxPerDEDim(3,i3)
k=k+1
enddo
enddo
enddo
endif
! do i=1,deCount
! write(*,*) i,"min=",deBlockList(:,1,i)," max=",deBlockList(:,2,i)
! enddo
! Setup Connections between tile sides ----------------------------------------
! CONNECTIONS DON'T WORK YET SO NOT IMPLEMENTED
! Process PetMap --------------------------------------------------------------
if (present(petMap)) then
!! Allocate petList
allocate(petList(deCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating petList", &
ESMF_CONTEXT, rcToReturn=rc)) return
!! copy petMap to petList
if (dimCount > 2) then
k=1
do i3=1,size(countsPerDEDim3Local)
do i2=1,size(countsPerDEDim2Local)
do i1=1,size(countsPerDEDim1Local)
petList(k)=petMap(i1,i2,i3)
k=k+1
enddo
enddo
enddo
else
k=1
do i3=1,1
do i2=1,size(countsPerDEDim2Local)
do i1=1,size(countsPerDEDim1Local)
petList(k)=petMap(i1,i2,i3)
k=k+1
enddo
enddo
enddo
endif
!! create delayout from the petList
delayout=ESMF_DELayoutCreate(petMap=petList,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! Get rid of list
deallocate(petList)
else
!! create a default delayout
delayout=ESMF_DELayoutCreate(deCount=deCount,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Create DistGrid --------------------------------------------------------------
distgrid=ESMF_DistGridCreate(minIndex=minIndexLocal, maxIndex=maxIndexLocal, &
deBlockList=deBlockList, delayout=delayout, indexflag=indexflag, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Convert coordDeps to coordDimCount and coordDimMap -------------------------------
allocate(coordDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimCount", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(coordDimMap(dimCount,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(coordDep1)) then
coordDimCount(1)=size(coordDep1)
coordDimMap(1,:)=0
do i=1,size(coordDep1)
coordDimMap(1,i)=coordDep1(i)
enddo
else
coordDimCount(1)=dimCount
do i=1,dimCount
coordDimMap(1,i)=i
enddo
endif
if (present(coordDep2)) then
coordDimCount(2)=size(coordDep2)
coordDimMap(2,:)=0
do i=1,size(coordDep2)
coordDimMap(2,i)=coordDep2(i)
enddo
else
coordDimCount(2)=dimCount
do i=1,dimCount
coordDimMap(2,i)=i
enddo
endif
if (dimCount > 2) then
if (present(coordDep3)) then
coordDimCount(3)=size(coordDep3)
coordDimMap(3,:)=0
do i=1,size(coordDep3)
coordDimMap(3,i)=coordDep3(i)
enddo
else
coordDimCount(3)=dimCount
do i=1,dimCount
coordDimMap(3,i)=i
enddo
endif
endif
! Create Grid from specification -----------------------------------------------
call ESMF_GridSetFromDistGrid(grid, coordTypeKind=coordTypeKind, &
distgrid=distgrid, distgridToGridMap=distgridToGridMap, &
coordDimCount=coordDimCount, coordDimMap=coordDimMap, &
gridEdgeLWidth=gridEdgeLWidthLocal, &
gridEdgeUWidth=gridEdgeUWidthLocal, &
gridAlign=gridAlignLocal, &
gridMemLBound=gridMemLBound, &
indexflag=indexflag, &
name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set internal items to be destroyed with grid
call ESMF_GridSetDestroyDistgrid(grid,destroy=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout(grid,destroy=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Commit Grid -----------------------------------------------------------------
call ESMF_GridCommit(grid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(maxIndexLocal)
deallocate(minIndexLocal)
deallocate(coordDimCount)
deallocate(coordDimMap)
deallocate(distgridToGridMap)
deallocate(maxPerDEDim)
deallocate(minPerDEDim)
deallocate(deDimCount)
deallocate(deBlockList)
deallocate(gridEdgeLWidthLocal)
deallocate(gridEdgeUWidthLocal)
deallocate(gridAlignLocal)
deallocate(countsPerDEDim1Local)
deallocate(countsPerDEDim2Local)
if (dimCount > 2) then
deallocate(countsPerDEDim3Local)
endif
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridSetCmmitShapeTileIrreg
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridSetCmmitShapeTileReg"
!BOPI
! !IROUTINE: ESMF_GridSetCommitShapeTile - Set and complete a Grid with a regular distribution
! !INTERFACE:
! Private name; call using ESMF_GridSetCommitShapeTile()
subroutine ESMF_GridSetCmmitShapeTileReg(grid, name, coordTypeKind, &
regDecomp, decompFlag, minIndex, maxIndex, &
keywordEnforcer, connflagDim1, connflagDim2, connflagDim3, &
poleStaggerLoc1, poleStaggerLoc2, poleStaggerLoc3, &
bipolePos1, bipolePos2, bipolePos3, &
coordDep1, coordDep2, coordDep3, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridMemLBound, indexflag, petMap, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(inout) :: grid
character (len=*), intent(in), optional :: name
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: regDecomp(:)
type(ESMF_Decomp_Flag), intent(in), optional :: decompflag(:)
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: maxIndex(:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim1(:) !N. IMP.
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim2(:) !N. IMP.
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim3(:) !N. IMP.
type(ESMF_StaggerLoc),intent(in),optional::poleStaggerLoc1(2)!N. IMP.
type(ESMF_StaggerLoc),intent(in),optional::poleStaggerLoc2(2)!N. IMP.
type(ESMF_StaggerLoc),intent(in),optional::poleStaggerLoc3(2)!N. IMP.
integer, intent(in), optional :: bipolePos1(2) !N. IMP.
integer, intent(in), optional :: bipolePos2(2) !N. IMP.
integer, intent(in), optional :: bipolePos3(2) !N. IMP.
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(in), optional :: gridEdgeLWidth(:)
integer, intent(in), optional :: gridEdgeUWidth(:)
integer, intent(in), optional :: gridAlign(:)
integer, intent(in), optional :: gridMemLBound(:)
type(ESMF_Index_Flag), intent(in), optional :: indexflag
integer, intent(in), optional :: petMap(:,:,:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method sets information into an empty Grid and then commits it to
! create a single tile, regularly distributed grid
! (see Figure \ref{fig:GridDecomps}).
! To specify the distribution, the user passes in an array
! ({\tt regDecomp}) specifying the number of DEs to divide each
! dimension into. If the number of DEs is 1 than the dimension is undistributed.
! The array {\tt decompFlag} indicates how the division into DEs is to
! occur. The default is to divide the range as evenly as possible.
!
! For consistency's sake the {\tt ESMF\_GridSetCommitShapeTile()} call
! should be executed in the same set or a subset of the PETs in which the
! {\tt ESMF\_GridEmptyCreate()} call was made. If the call
! is made in a subset, the Grid objects outside that subset will
! still be "empty" and not usable.
!
! The arguments are:
! \begin{description}
! \item[{grid}]
! {\tt ESMF\_Grid} to set information into and then commit.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[regDecomp]}]
! List that has the same number of elements as {\tt maxIndex}.
! Each entry is the number of decounts for that dimension.
! If not specified, the default decomposition will be petCountx1x1..x1.
! \item[{[decompflag]}]
! List of decomposition flags indicating how each dimension of the
! tile is to be divided between the DEs. The default setting
! is {\tt ESMF\_DECOMP\_BALANCED} in all dimensions. Please see
! Section~\ref{const:decompflag} for a full description of the
! possible options. Note that currently the option
! {\tt ESMF\_DECOMP\_CYCLIC} isn't supported in Grid creation.
! \item[{[minIndex]}]
! The bottom extent of the grid array. If not given then the value defaults
! to /1,1,1,.../.
! \item[{maxIndex}]
! The upper extent of the grid array.
! \item[{[connflagDim1]}]
! Fortran array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[connflagDim2]}]
! Fortran array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[connflagDim3]}]
! Fortran array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[poleStaggerLoc1]}]
! Two element array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If a pole, this describes which staggerlocation is at the pole at each end.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[poleStaggerLoc2]}]
! Two element array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If a pole, this describes which staggerlocation is at the pole at each end.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[poleStaggerLoc3]}]
! Two element array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If a pole, this describes which staggerlocation is at the pole at each end.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[bipolePos1]}]
! Two element array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If a bipole, this gives the index position of one of the poles.
! The other is half way around. If not present, the default is 1.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[bipolePos2]}]
! Two element array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If a bipole, this gives the index position of one of the poles.
! The other is half way around. If not present, the default is 1.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[bipolePos3]}]
! Two element array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If a bipole, this gives the index position of one of the poles.
! The other is half way around. If not present, the default is 1.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[coordDep1]}]
! This array specifies the dependence of the first
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the first
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep2]}]
! This array specifies the dependence of the second
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the second
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[coordDep3]}]
! This array specifies the dependence of the third
! coordinate component on the three index dimensions
! described by {\tt coordsPerDEDim1,2,3}. The size of the
! array specifies the number of dimensions of the third
! coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. If not present the default is 1,2,...,grid rank.
! \item[{[gridEdgeLWidth]}]
! The padding around the lower edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 0, 0, ..., 0 (all zeros).
! \item[{[gridEdgeUWidth]}]
! The padding around the upper edges of the grid. This padding is between
! the index space corresponding to the cells and the boundary of the
! the exclusive region. This extra space is to contain the extra
! padding for non-center stagger locations, and should be big enough
! to hold any stagger in the grid. If this and gridAlign are not present then
! defaults to 1, 1, ..., 1 (all ones).
! \item[{[gridAlign]}]
! Specification of how the stagger locations should align with the cell
! index space (can be overridden by the individual staggerAligns). If
! the gridEdgeWidths are not specified than this argument
! implies the gridEdgeWidths. If the gridEdgeWidths are specified and this argument isn't
! then this argument is implied by the gridEdgeWidths.
! If this and the gridEdgeWidths are not specified, then defaults to
! -1, -1, ..., -1 (all negative ones).
! \item[{[gridMemLBound]}]
! Specifies the lower index range of the memory of every DE in this Grid.
! Only used when indexflag is {\tt ESMF\_INDEX\_USER}. May be overridden
! by staggerMemLBound.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[petMap]}]
! Sets the mapping of pets to the created DEs. This 3D
! should be of size regDecomp(1) x regDecomp(2) x regDecomp(3)
! If the Grid is 2D, then the last dimension is of size 1.
! If the Grid contains undistributed dimensions then these
! should also be of size 1.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
type(ESMF_DistGrid) :: distgrid
type(ESMF_DELayout) :: delayout
type(ESMF_VM) :: vm
integer, pointer :: petList(:)
integer, pointer :: undistLBound(:)
integer, pointer :: undistUBound(:)
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer :: localrc
integer :: dimCount,i,maxSizeDEDim
integer, pointer :: regDecompDG(:)
type(ESMF_Decomp_Flag), pointer :: decompflagDG(:)
integer, pointer :: regDecompLocal(:)
type(ESMF_Decomp_Flag), pointer :: decompflagLocal(:)
integer, pointer :: distgridToGridMap(:), deDimCount(:)
integer, pointer :: minIndexLocal(:), maxIndexLocal(:)
integer, pointer :: gridEdgeLWidthLocal(:)
integer, pointer :: gridEdgeUWidthLocal(:)
integer, pointer :: gridAlignLocal(:)
integer :: deCount
integer :: d,i1,i2,i3,k
type(ESMF_GridConn_Flag) :: connflagDim1Local(2)
type(ESMF_GridConn_Flag) :: connflagDim2Local(2)
type(ESMF_GridConn_Flag) :: connflagDim3Local(2)
integer :: connCount, petListCount
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Compute the Grid DimCount and Derivatives ---------------------------------------------------
! dimCount
dimCount=size(maxIndex)
if ((dimCount < 2) .or. (dimCount > 3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- maxIndex size and thus Grid dimCount must be either 2 or 3 when using create shape ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Argument Consistency Checking --------------------------------------------------------------
if (present(regDecomp)) then
if (size(regDecomp) .lt. dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- regDecomp size doesn't match Grid dimCount ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(decompFlag)) then
if (size(decompFlag) .lt. dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- decompFlag size doesn't match Grid dimCount ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! CYCLIC decomposition isn't allowed when creating a Grid
do i=1,size(decompFlag)
if (decompFlag(i) == ESMF_DECOMP_CYCLIC) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_OUTOFRANGE, &
msg="- decompFlag isn't allowed to be" // &
" ESMF_DECOMP_CYCLIC when creating a Grid.", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
enddo
endif
if ((dimCount .lt. 3) .and. present(connflagDim3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- connflagDim3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((dimCount .lt. 3) .and. present(poleStaggerLoc3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- poleStaggerLoc3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((dimCount .lt. 3) .and. present(bipolePos3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- bipolePos3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((dimCount .lt. 3) .and. present(coordDep3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- coordDep3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (present(coordDep1)) then
if ((size(coordDep1) < 1) .or. (size(coordDep1)>dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- coordDep1 size incompatible with grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(coordDep2)) then
if ((size(coordDep2) < 1) .or. (size(coordDep2)>dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- coordDep2 size incompatible with grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(coordDep3)) then
if ((size(coordDep3) < 1) .or. (size(coordDep3)>dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- coordDep3 size incompatible with grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(minIndex)) then
if (size(minIndex) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- minIndex size must equal grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! Check DimCount of gridWidths and Aligns
if (present(gridEdgeLWidth)) then
if (size(gridEdgeLWidth) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridEdgeLWidth must be of size equal to Grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridEdgeUWidth)) then
if (size(gridEdgeUWidth) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridEdgeUWidth must be of size equal to Grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridAlign)) then
if (size(gridAlign) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridAlign must be of size equal to Grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! make sure connected dimensions don't have an edge width
if (present(connflagDim1)) then
if (size(connflagDim1) == 1) then
if (connflagDim1(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(1) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(1) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
else if (size(connflagDim1) == 2) then
if (connflagDim1(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(1) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
if (connflagDim1(2) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(1) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
endif
endif
! make sure connected dimensions don't have an edge width
if (present(connflagDim2)) then
if (size(connflagDim2) == 1) then
if (connflagDim2(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(2) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(2) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
else if (size(connflagDim2) == 2) then
if (connflagDim2(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(2) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
if (connflagDim2(2) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(2) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
endif
endif
! make sure connected dimensions don't have an edge width
if (present(connflagDim3)) then
if (size(connflagDim3) == 1) then
if (connflagDim3(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(3) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(3) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
else if (size(connflagDim3) == 2) then
if (connflagDim3(1) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeLWidth)) then
if (gridEdgeLWidth(3) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have LWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
if (connflagDim3(2) /= ESMF_GRIDCONN_NONE) then
if (present(gridEdgeUWidth)) then
if (gridEdgeUWidth(3) > 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Connected dimensions must have UWidth 0", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
endif
endif
! check for gridMemLBound issues
if (present(gridMemLBound)) then
if (.not. present(indexflag)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- when using gridMemLBound must specify indexflag=ESMF_INDEX_USER ", &
ESMF_CONTEXT, rcToReturn=rc)
return
else if (.not.(indexflag == ESMF_INDEX_USER)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- when using gridMemLBound must specify indexflag=ESMF_INDEX_USER ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else
if (present(indexflag)) then
if (indexflag == ESMF_INDEX_USER) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- when using indexflag=ESMF_INDEX_USER must provide gridMemLBound ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
! Check for non-valid connection types here
!TODO: Consider making some of these a separate local subroutine (particularly if you're going to
! have 3 of these ShapeCreate subroutines with only minor changes
! Set Defaults ------------------------------------------------------------------
! Set default for minIndex
allocate(minIndexLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(minIndex)) then
minIndexLocal(:)=minIndex(:)
else
do i=1,dimCount
minIndexLocal(i)=1
enddo
endif
! Set default for maxIndex
allocate(maxIndexLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
maxIndexLocal(:)=maxIndex(:)
! Set default for regDecomp
allocate(regDecompLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating regDecompLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(regDecomp)) then
regDecompLocal(:)=regDecomp(:)
else
! The default is 1D divided among all the Pets
call ESMF_VMGetCurrent(vm,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_VMGet(vm,petCount=regDecompLocal(1),rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
do i=2,dimCount
regDecompLocal(i)=1
enddo
endif
! Set Default for connections (although they don't work yet in distgrid/array, so they aren't really used anywhere yet.)
if (present(connflagDim1)) then
if (size(connflagDim1) == 1) then
connflagDim1Local(1)=connflagDim1(1)
connflagDim1Local(2)=connflagDim1(1) ! if only 1 connection is specified then repeat for both ends
else if (size(connflagDim1) >= 2) then
connflagDim1Local(1)=connflagDim1(1)
connflagDim1Local(2)=connflagDim1(2)
endif
else
connflagDim1Local(1)=ESMF_GRIDCONN_NONE ! if not present then default to no connection
connflagDim1Local(2)=ESMF_GRIDCONN_NONE
endif
if (present(connflagDim2)) then
if (size(connflagDim2) == 1) then
connflagDim2Local(1)=connflagDim2(1)
connflagDim2Local(2)=connflagDim2(1) ! if only 1 connection is specified then repeat for both ends
else if (size(connflagDim2) >= 2) then
connflagDim2Local(1)=connflagDim2(1)
connflagDim2Local(2)=connflagDim2(2)
endif
else
connflagDim2Local(1)=ESMF_GRIDCONN_NONE ! if not present then default to no connection
connflagDim2Local(2)=ESMF_GRIDCONN_NONE
endif
if (present(connflagDim3)) then
if (size(connflagDim3) == 1) then
connflagDim3Local(1)=connflagDim3(1)
connflagDim3Local(2)=connflagDim3(1) ! if only 1 connection is specified then repeat for both ends
else if (size(connflagDim3) >= 2) then
connflagDim3Local(1)=connflagDim3(1)
connflagDim3Local(2)=connflagDim3(2)
endif
else
connflagDim3Local(1)=ESMF_GRIDCONN_NONE ! if not present then default to no connection
connflagDim3Local(2)=ESMF_GRIDCONN_NONE
endif
! check for not implemented functionality
if (connflagDim1Local(1) /= ESMF_GRIDCONN_NONE .or. &
connflagDim1Local(2) /= ESMF_GRIDCONN_NONE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- Only ESMF_GRIDCONN_NONE Grid connection implemented so far", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (connflagDim2Local(1) /= ESMF_GRIDCONN_NONE .or. &
connflagDim2Local(2) /= ESMF_GRIDCONN_NONE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- Only ESMF_GRIDCONN_NONE Grid connection implemented so far", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (connflagDim3Local(1) /= ESMF_GRIDCONN_NONE .or. &
connflagDim3Local(2) /= ESMF_GRIDCONN_NONE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- Only ESMF_GRIDCONN_NONE Grid connection implemented so far", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (present(petMap)) then
if (dimCount > 2) then
if ((size(petMap,1) /= regDecompLocal(1)) .or. &
(size(petMap,2) /= regDecompLocal(2)) .or. &
(size(petMap,3) /= regDecompLocal(3))) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- petMap wrong size in one or more dimensions", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else
if ((size(petMap,1) /= regDecompLocal(1)) .or. &
(size(petMap,2) /= regDecompLocal(2)) .or. &
(size(petMap,3) /= 1)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- petMap wrong size in one or more dimensions", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
! Modify Bounds by GridEdgeUWidth and GridEdgeLWidth -------------------------
! setup maxIndexLocal to hold modified bounds
allocate(gridEdgeLWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeLWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridEdgeUWidthLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridEdgeUWidthLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(gridAlignLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating gridAlignLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridLUADefault(dimCount, &
gridEdgeLWidth, gridEdgeUWidth, gridAlign, &
gridEdgeLWidthLocal, gridEdgeUWidthLocal, gridAlignLocal, &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
#if 0
! Modify lower bound
do i=1,dimCount
minIndexLocal(i)=minIndexLocal(i)-gridEdgeLWidthLocal(i)
enddo
! Modify upper bound
do i=1,dimCount
maxIndexLocal(i)=maxIndexLocal(i)+gridEdgeUWidthLocal(i)
enddo
#endif
! Set default for decomp flag based on gridEdgeWidths -----------------------------------
! NOTE: This is a temporary fix until we have something better implemented in distGrid
! Set default for decompFlag
allocate(decompFlagLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating decompFlagLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(decompFlag)) then
decompFlagLocal(:)=decompFlag(:)
else
decompFlagLocal(:)=ESMF_DECOMP_BALANCED
endif
allocate(distgridToGridMap(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating distgridToGridMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
do i=1,dimCount
distgridToGridMap(i)=i
enddo
! Setup Connections between tile sides ----------------------------------------
! CONNECTIONS DON'T WORK YET SO NOT IMPLEMENTED
! Process PetMap --------------------------------------------------------------
!! Calculate deCount
deCount=1
do i=1,dimCount
deCount=deCount*regDecompLocal(i)
enddo
! create DELayout based on presence of petMap
if (present(petMap)) then
!! Allocate petList
allocate(petList(deCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating petList", &
ESMF_CONTEXT, rcToReturn=rc)) return
!! copy petMap to petList
if (dimCount > 2) then
k=1
do i3=1,regDecompLocal(3)
do i2=1,regDecompLocal(2)
do i1=1,regDecompLocal(1)
petList(k)=petMap(i1,i2,i3)
k=k+1
enddo
enddo
enddo
else
k=1
do i3=1,1
do i2=1,regDecompLocal(2)
do i1=1,regDecompLocal(1)
petList(k)=petMap(i1,i2,i3)
k=k+1
enddo
enddo
enddo
endif
!! create delayout from the petList
delayout=ESMF_DELayoutCreate(petMap=petList,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! Get rid of list
deallocate(petList)
else
!! create a default delayout
delayout=ESMF_DELayoutCreate(deCount=deCount,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Create DistGrid --------------------------------------------------------------
distgrid=ESMF_DistGridCreate(minIndex=minIndexLocal, maxIndex=maxIndexLocal, &
regDecomp=regDecompLocal, decompFlag=decompFlagLocal, delayout=delayout,&
indexflag=indexflag, &
#if 0
regDecompFirstExtra=gridEdgeLWidthLocal, &
regDecompLastExtra=gridEdgeUWidthLocal, &
#endif
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Convert coordDeps to coordDimCount and coordDimMap -------------------------------
allocate(coordDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimCount", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(coordDimMap(dimCount,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(coordDep1)) then
coordDimCount(1)=size(coordDep1)
coordDimMap(1,:)=0
do i=1,size(coordDep1)
coordDimMap(1,i)=coordDep1(i)
enddo
else
coordDimCount(1)=dimCount
do i=1,dimCount
coordDimMap(1,i)=i
enddo
endif
if (present(coordDep2)) then
coordDimCount(2)=size(coordDep2)
coordDimMap(2,:)=0
do i=1,size(coordDep2)
coordDimMap(2,i)=coordDep2(i)
enddo
else
coordDimCount(2)=dimCount
do i=1,dimCount
coordDimMap(2,i)=i
enddo
endif
if (dimCount > 2) then
if (present(coordDep3)) then
coordDimCount(3)=size(coordDep3)
coordDimMap(3,:)=0
do i=1,size(coordDep3)
coordDimMap(3,i)=coordDep3(i)
enddo
else
coordDimCount(3)=dimCount
do i=1,dimCount
coordDimMap(3,i)=i
enddo
endif
endif
! Create Grid from specification -----------------------------------------------
call ESMF_GridSetFromDistGrid(grid, coordTypeKind=coordTypeKind, &
distgrid=distgrid, distgridToGridMap=distgridToGridMap, &
coordDimCount=coordDimCount, coordDimMap=coordDimMap, &
gridEdgeLWidth=gridEdgeLWidthLocal, &
gridEdgeUWidth=gridEdgeUWidthLocal, &
gridAlign=gridAlignLocal, &
gridMemLBound=gridMemLBound, &
indexflag=indexflag, &
name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Commit Grid -----------------------------------------------------------------
call ESMF_GridCommit(grid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(regDecompLocal)
deallocate(decompFlagLocal)
deallocate(coordDimCount)
deallocate(coordDimMap)
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
deallocate(distgridToGridMap)
deallocate(gridEdgeLWidthLocal)
deallocate(gridEdgeUWidthLocal)
deallocate(gridAlignLocal)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridSetCmmitShapeTileReg
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridSetCmmitShapeTileArb"
!BOPI
! !IROUTINE: ESMF_GridSetCommitShapeTile - Create a Grid with an arbitrary distribution
! !INTERFACE:
! Private name; call using ESMF_GridSetCommitShapeTile()
subroutine ESMF_GridSetCmmitShapeTileArb(grid, name,coordTypeKind, &
minIndex, maxIndex, arbIndexCount, arbIndexList, &
keywordEnforcer, connflagDim1, connflagDim2, connflagDim3, &
poleStaggerLoc1, poleStaggerLoc2, poleStaggerLoc3, &
bipolePos1, bipolePos2, bipolePos3, &
coordDep1, coordDep2, coordDep3, &
distDim, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(inout) :: grid
character (len=*), intent(in), optional :: name
type(ESMF_TypeKind_Flag), intent(in), optional :: coordTypeKind
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: maxIndex(:)
integer, intent(in) :: arbIndexCount
integer, intent(in) :: arbIndexList(:,:)
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim1(:) !N. IMP.
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim2(:) !N. IMP.
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim3(:) !N. IMP.
type(ESMF_StaggerLoc),intent(in),optional::poleStaggerLoc1(2)!N. IMP.
type(ESMF_StaggerLoc),intent(in),optional::poleStaggerLoc2(2)!N. IMP.
type(ESMF_StaggerLoc),intent(in),optional::poleStaggerLoc3(2)!N. IMP.
integer, intent(in), optional :: bipolePos1(2) !N. IMP.
integer, intent(in), optional :: bipolePos2(2) !N. IMP.
integer, intent(in), optional :: bipolePos3(2) !N. IMP.
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(in), optional :: distDim(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This method set an empty grid as a single tile, arbitrarily distributed grid
! (see Figure \ref{fig:GridDecomps}).
! To specify the arbitrary distribution, the user passes in an 2D array
! of local indices, where the first dimension is the number of local grid cells
! specified by arbIndexCount and the second dimension is the number of distributed
! dimensions.
!
! {\tt distDim} specifies which grid dimensions are arbitrarily distributed. The
! size of {\tt distDim} has to agree with the size of the second dimension of
! {\tt arbIndexList}.
!
! For consistency's sake the {\tt ESMF\_GridSetCommitShapeTile()} call
! should be executed in the same set or a subset of the PETs in which the
! {\tt ESMF\_GridEmptyCreate()} call was made. If the call
! is made in a subset, the Grid objects outside that subset will
! still be "empty" and not usable.
!
! The arguments are:
! \begin{description}
! \item[{[grid]}]
! The empty {\tt ESMF\_Grid} to set information into and then commit.
! \item[{[name]}]
! {\tt ESMF\_Grid} name.
! \item[{[coordTypeKind]}]
! The type/kind of the grid coordinate data. All {\em numerical} types
! listed under section~\ref{const:typekind} are supported.
! If not specified then defaults to ESMF\_TYPEKIND\_R8.
! \item[{[minIndex]}]
! Tuple to start the index ranges at. If not present, defaults
! to /1,1,1,.../.
! \item[{[maxIndex]}]
! The upper extend of the grid index ranges.
! \item[{[arbIndexList]}]
! This 2D array specifies the indices of the local grid cells. The
! dimensions should be arbIndexCount * number of Distributed grid dimensions
! where arbIndexCount is the input argument specified below
! \item[{arbIndexCount}]
! The number of grid cells in the local DE
! \item[{[connflagDim1]}]
! Fortran array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[connflagDim2]}]
! Fortran array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[connflagDim3]}]
! Fortran array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If array is only one element long, then that element is used
! for both the minimum and maximum end.
! Please see Section~\ref{const:gridconn} for a list of valid
! options. If not present, defaults to ESMF\_GRIDCONN\_NONE.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[poleStaggerLoc1]}]
! Two element array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If a pole, this describes which staggerlocation is at the pole at each end.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[poleStaggerLoc2]}]
! Two element array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If a pole, this describes which staggerlocation is at the pole at each end.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[poleStaggerLoc3]}]
! Two element array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If a pole, this describes which staggerlocation is at the pole at each end.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to ESMF\_STAGGERLOC\_CENTER.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[bipolePos1]}]
! Two element array describing the index dimension 1 connections.
! The first element represents the minimum end of dimension 1.
! The second element represents the maximum end of dimension 1.
! If a bipole, this gives the index position of one of the poles.
! The other is half way around. If not present, the default is 1.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[bipolePos2]}]
! Two element array describing the index dimension 2 connections.
! The first element represents the minimum end of dimension 2.
! The second element represents the maximum end of dimension 2.
! If a bipole, this gives the index position of one of the poles.
! The other is half way around. If not present, the default is 1.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[bipolePos3]}]
! Two element array describing the index dimension 3 connections.
! The first element represents the minimum end of dimension 3.
! The second element represents the maximum end of dimension 3.
! If a bipole, this gives the index position of one of the poles.
! The other is half way around. If not present, the default is 1.
! [CURRENTLY NOT IMPLEMENTED]
! \item[{[coordDep1]}]
! The size of the array specifies the number of dimensions of the
! first coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. The format should be /ESMF\_DIM\_ARB/ where
! /ESMF\_DIM\_ARB/ is mapped to the collapsed 1D dimension from all
! the arbitrarily distributed dimensions. n is the dimension that
! is not distributed (if exists).
! If not present the default is /ESMF\_DIM\_ARB/ if the first dimension
! is arbitararily distributed, or /n/ if not distributed (i.e. n=1)
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_DIM\_ARB.
! \item[{[coordDep2]}]
! The size of the array specifies the number of dimensions of the
! second coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. The format should be /ESMF\_DIM\_ARB/ where
! /ESMF\_DIM\_ARB/ is mapped to the collapsed 1D dimension from all
! the arbitrarily distributed dimensions. n is the dimension that
! is not distributed (if exists).
! If not present the default is /ESMF\_DIM\_ARB/ if this dimension
! is arbitararily distributed, or /n/ if not distributed (i.e. n=2)
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_DIM\_ARB.
! \item[{[coordDep3]}]
! The size of the array specifies the number of dimensions of the
! third coordinate component array. The values specify which
! of the index dimensions the corresponding coordinate
! arrays map to. The format should be /ESMF\_DIM\_ARB/ where
! /ESMF\_DIM\_ARB/ is mapped to the collapsed 1D dimension from all
! the arbitrarily distributed dimensions. n is the dimension that
! is not distributed (if exists).
! If not present the default is /ESMF\_DIM\_ARB/ if this dimension
! is arbitararily distributed, or /n/ if not distributed (i.e. n=3)
! Please see Section~\ref{const:arbdim} for a definition of ESMF\_DIM\_ARB.
! \item[{[distDim]}]
! This array specifies which dimensions are arbitrarily distributed.
! The size of the array specifies the total distributed dimensions.
! if not specified, defaults is all dimensions will be arbitrarily
! distributed. The size has to agree with the size of the second
! dimension of {\tt arbIndexList}.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
type(ESMF_DistGrid) :: distgrid
type(ESMF_DELayout) :: delayout
integer, pointer :: petList(:)
integer, pointer :: undistLBound(:)
integer, pointer :: undistUBound(:)
integer, pointer :: coordDimCount(:)
integer, pointer :: coordDimMap(:,:)
integer :: localrc
integer :: dimCount,distDimCount,undistDimCount
integer, pointer :: deDimCount(:)
integer, pointer :: minIndexLocal(:)
integer, pointer :: maxIndexLocal(:)
integer :: i,j,d,f,i1,i2,i3,k,ind,ud
type(ESMF_GridConn_Flag) :: connflagDim1Local(2)
type(ESMF_GridConn_Flag) :: connflagDim2Local(2)
type(ESMF_GridConn_Flag) :: connflagDim3Local(2)
integer :: connCount, petListCount
integer :: top
integer, pointer :: distSize(:)
integer, pointer :: distDimLocal(:)
logical, pointer :: isDist(:)
integer, pointer :: local1DIndices(:)
logical :: found
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Compute the Grid DimCount and Derivatives ---------------------------------------------------
! dimCount
dimCount=size(maxIndex)
if ((dimCount < 2) .or. (dimCount > 3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- maxIndex size and thus Grid dimCount must be either 2 or 3 when using create shape ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! number of distributed dimension, distDimCount, is determined by the second dim of
! arbIndexList
distDimCount = size(arbIndexList,2)
if (distDimCount > dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- the second dim of arbIndexList must be equal or less than grid dimension", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
allocate(distDimLocal(distDimCount), stat=localrc)
allocate(isDist(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating distDimLocal or isDist", &
ESMF_CONTEXT, rcToReturn=rc)) return
isDist(:)=.false.
! check distribution info
if (present(distDim)) then
if (size(distDim) /= distDimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- distDim must match with the second dimension of arbIndexList", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
distDimLocal(:)=distDim(:)
do i=1,distDimCount
isDist(distDimLocal(i))=.true.
enddo
else
do i=1,distDimCount
distDimLocal(i)=i
enddo
isDist(1:distDimCount)=.true.
endif
! Argument Consistency Checking --------------------------------------------------------------
if ((dimCount .lt. 3) .and. present(connflagDim3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- connflagDim3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((dimCount .lt. 3) .and. present(poleStaggerLoc3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- poleStaggerLoc3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((dimCount .lt. 3) .and. present(bipolePos3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- bipolePos3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (present(minIndex)) then
if (size(minIndex) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- minIndex size must equal grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! Check for non-valid connection types here
! Set Defaults -------------------------------------------------------------
! Set default for minIndex
allocate(minIndexLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(minIndex)) then
minIndexLocal(:)=minIndex(:)
else
do i=1,dimCount
minIndexLocal(i)=1
enddo
endif
! Set default for maxIndex
allocate(maxIndexLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxIndexLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
maxIndexLocal(:)=maxIndex(:)
allocate(distSize(distDimCount),stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating distSize", &
ESMF_CONTEXT, rcToReturn=rc)) return
do i=1,distDimCount
ind = distDimLocal(i)
distSize(i)=maxIndexLocal(ind)-minIndexLocal(ind)+1
enddo
! dimCounts of the undistributed part of the grid
undistDimCount=dimCount-distDimCount
! can't have all undistributed dimensions
if (distDimCount == 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Need to have at least one distributed dimension", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Check arbIndexList dimension matched with arbIndexCount and diskDimCount
if (size(arbIndexList, 1) /= arbIndexCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- arbIndexList 1st dimension has to match with arbIndexCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
allocate(local1DIndices(arbIndexCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating local1DIndices", &
ESMF_CONTEXT, rcToReturn=rc)) return
! convert arbIndexList into 1D index array for DistGrid
if (arbIndexCount > 0) then
do i = 1, arbIndexCount
local1DIndices(i) = arbIndexList(i,1)-1
if (distDimCount >= 2) then
do j = 2, distDimCount
local1DIndices(i) = local1DIndices(i)*distSize(j) + arbIndexList(i,j)-1
enddo
endif
local1DIndices(i) = local1DIndices(i)+1
enddo
endif
! Set Default for connections (although they don't work yet in distgrid/array, so they aren't really used anywhere yet.)
if (present(connflagDim1)) then
if (size(connflagDim1) == 1) then
connflagDim1Local(1)=connflagDim1(1)
connflagDim1Local(2)=connflagDim1(1) ! if only 1 connection is specified then repeat for both ends
else if (size(connflagDim1) >= 2) then
connflagDim1Local(1)=connflagDim1(1)
connflagDim1Local(2)=connflagDim1(2)
endif
else
connflagDim1Local(1)=ESMF_GRIDCONN_NONE ! if not present then default to no connection
connflagDim1Local(2)=ESMF_GRIDCONN_NONE
endif
if (present(connflagDim2)) then
if (size(connflagDim2) == 1) then
connflagDim2Local(1)=connflagDim2(1)
connflagDim2Local(2)=connflagDim2(1) ! if only 1 connection is specified then repeat for both ends
else if (size(connflagDim2) >= 2) then
connflagDim2Local(1)=connflagDim2(1)
connflagDim2Local(2)=connflagDim2(2)
endif
else
connflagDim2Local(1)=ESMF_GRIDCONN_NONE ! if not present then default to no connection
connflagDim2Local(2)=ESMF_GRIDCONN_NONE
endif
if (present(connflagDim3)) then
if (size(connflagDim3) == 1) then
connflagDim3Local(1)=connflagDim3(1)
connflagDim3Local(2)=connflagDim3(1) ! if only 1 connection is specified then repeat for both ends
else if (size(connflagDim3) >= 2) then
connflagDim3Local(1)=connflagDim3(1)
connflagDim3Local(2)=connflagDim3(2)
endif
else
connflagDim3Local(1)=ESMF_GRIDCONN_NONE ! if not present then default to no connection
connflagDim3Local(2)=ESMF_GRIDCONN_NONE
endif
! check for not implemented functionality
if (connflagDim1Local(1) /= ESMF_GRIDCONN_NONE .or. &
connflagDim1Local(2) /= ESMF_GRIDCONN_NONE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- Only ESMF_GRIDCONN_NONE Grid connection implemented so far", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (connflagDim2Local(1) /= ESMF_GRIDCONN_NONE .or. &
connflagDim2Local(2) /= ESMF_GRIDCONN_NONE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- Only ESMF_GRIDCONN_NONE Grid connection implemented so far", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (connflagDim3Local(1) /= ESMF_GRIDCONN_NONE .or. &
connflagDim3Local(2) /= ESMF_GRIDCONN_NONE) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_NOT_IMPL, &
msg="- Only ESMF_GRIDCONN_NONE Grid connection implemented so far", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Setup Connections between tile sides ----------------------------------------
! CONNECTIONS DON'T WORK YET SO NOT IMPLEMENTED
! Convert coordDeps to coordDimCount and coordDimMap -------------------------------
allocate(coordDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimCount", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(coordDimMap(dimCount,dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating coordDimMap", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(coordDep1)) then
! error checking, if this dimension is arbitrary, one of the
! coordinate dimension has to be be ESMF_DIM_ARB
if (isDist(1)) then
found = .false.
do i=1,size(coordDep1)
if (coordDep1(i) == ESMF_DIM_ARB) found = .true.
enddo
if (.not. found) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- coordDep1 does not contain ESMF_DIM_ARB", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
coordDimCount(1)=size(coordDep1)
coordDimMap(1,:)=0
do i=1,size(coordDep1)
coordDimMap(1,i)=coordDep1(i)
enddo
else
coordDimCount(1)=1
! ESMF_DIM_ARB if 1 is distributed, otherwise 1
if (isDist(1)) then
coordDimMap(1,1)=ESMF_DIM_ARB
else
coordDimMap(1,1)=1
endif
endif
if (present(coordDep2)) then
! error checking, one of the dimensions has to be ESMF_DIM_ARB
! if dimension 2 is arbitrary
if (isDist(2)) then
found = .false.
do i=1,size(coordDep2)
if (coordDep2(i) == ESMF_DIM_ARB) found = .true.
enddo
if (.not. found) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- coordDep2 does not contain ESMF_DIM_ARB", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
coordDimCount(2)=size(coordDep2)
coordDimMap(2,:)=0
do i=1,size(coordDep2)
coordDimMap(2,i)=coordDep2(i)
enddo
else
coordDimCount(2)=1
! ESMF_DIM_ARB if 1 is distributed, otherwise 1
if (isDist(2)) then
coordDimMap(2,1)=ESMF_DIM_ARB
else
coordDimMap(2,1)=2
endif
endif
if (dimCount > 2) then
if (present(coordDep3)) then
! error checking, one of the dimensions has to be ESMF_DIM_ARB
! if dimension 3 is arbitrary
if (isDist(3)) then
found = .false.
do i=1,size(coordDep3)
if (coordDep3(i) == ESMF_DIM_ARB) found = .true.
enddo
if (.not. found) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- coordDep3 does not contain ESMF_DIM_ARB", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
coordDimCount(3)=size(coordDep3)
coordDimMap(3,:)=0
do i=1,size(coordDep3)
coordDimMap(3,i)=coordDep3(i)
enddo
else
coordDimCount(3)=1
! ESMF_DIM_ARB if 1 is distributed, otherwise 1
if (isDist(3)) then
coordDimMap(3,1)=ESMF_DIM_ARB
else
coordDimMap(3,1)=3
endif
endif
endif
! Calc undistLBound, undistUBound for Grid -----------------------------------------------
if (undistDimCount > 0) then
allocate(undistLBound(undistDimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating undistLBound", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(undistUBound(undistDimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating undistUBound", &
ESMF_CONTEXT, rcToReturn=rc)) return
! Fill in undistLBound, undistUBound
ud=1
do i=1,dimCount
if (.not. isDist(i)) then
undistLBound(ud)=minIndexLocal(i)
undistUBound(ud)=maxIndexLocal(i)
ud=ud+1
endif
enddo
endif
! Create DistGrid --------------------------------------------------------------
if (undistDimCount > 0) then
distgrid=ESMF_DistGridCreate(local1DIndices, 1, undistLBound, undistUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
distgrid=ESMF_DistGridCreate(local1DIndices, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Create Grid from specification -----------------------------------------------
call ESMF_GridSetFromDistGrid(grid, coordTypeKind=coordTypeKind, &
distgrid=distgrid, distDim=distDimLocal, &
coordDimCount=coordDimCount, coordDimMap=coordDimMap, &
minIndex=minIndexLocal, maxIndex=maxIndexLocal, &
localArbIndexCount=arbIndexCount, localArbIndex=arbIndexList, &
name=name, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set internal items to be destroyed with grid
call ESMF_GridSetDestroyDistgrid(grid,destroy=.true., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridSetDestroyDELayout(grid,destroy=.false., rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(minIndexLocal)
deallocate(maxIndexLocal)
deallocate(local1DIndices)
deallocate(isDist)
deallocate(distDimLocal)
deallocate(coordDimCount)
deallocate(coordDimMap)
if (undistDimCount > 0) then
deallocate(undistLBound)
deallocate(undistUBound)
endif
deallocate(distSize)
! Commit Grid -----------------------------------------------------------------
call ESMF_GridCommit(grid, 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_GridSetCmmitShapeTileArb
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridSetItemFromArray"
!BOP
! !IROUTINE: ESMF_GridSetItem - Set an item using an Array
! !INTERFACE:
! Private name; call using ESMF_GridSetItem()
subroutine ESMF_GridSetItemFromArray(grid, itemflag, staggerloc, &
array, keywordEnforcer, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type (ESMF_GridItem_Flag), intent(in) :: itemflag
type (ESMF_StaggerLoc), intent(in), optional :: staggerloc
type(ESMF_Array), intent(in) :: array
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(out), optional :: rc
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \end{itemize}
!
! !DESCRIPTION:
! This method sets the passed in Array as the holder of the item data
! for stagger location {\tt staggerloc} and item {\tt itemflag}. If the location
! already contains an Array, then this one overwrites it. This method can
! be used as a replacement for ESMF\_GridAddItem().
!
! The arguments are:
!\begin{description}
!\item[grid]
! The grid in which to set the array.
!\item[itemflag]
! The item into which to copy the arrays. Please see Section~\ref{const:griditem} for a
! list of valid items.
!\item[{[staggerloc]}]
! The stagger location into which to copy the arrays.
! Please see Section~\ref{const:staggerloc} for a list
! of predefined stagger locations. If not present, defaults to
! ESMF\_STAGGERLOC\_CENTER.
!\item[array]
! An array to set the grid item information from.
!\item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
!\end{description}
!
!EOP
integer :: tmp_staggerloc
integer :: localrc ! local error status
type(ESMF_GridDecompType) :: decompType
type(ESMF_DataCopy_Flag) :: datacopyflag
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check init status of arguments
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_ArrayGetInit, array, rc)
ESMF_INIT_CHECK_DEEP_SHORT(ESMF_GridGetInit, grid, rc)
call ESMF_GridGetDecompType(grid, decompType, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! handle staggerloc
if (present(staggerloc)) then
if ((decompType == ESMF_GRID_ARBITRARY) .and. &
(staggerloc /= ESMF_STAGGERLOC_CENTER)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- staggerloc has to be ESMF_STAGGERLOC_CENTER for arbitrary grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
else
tmp_staggerloc=staggerloc%staggerloc
endif
else
tmp_staggerloc=ESMF_STAGGERLOC_CENTER%staggerloc
endif
! Use reference
datacopyflag=ESMF_DATACOPY_REFERENCE
! Call C++ Subroutine
call c_ESMC_gridsetitemfromarray(grid%this,tmp_staggerloc, itemflag, &
array, datacopyflag, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridSetItemFromArray
! -------------------------- ESMF-public method -------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridValidate()"
!BOP
! !IROUTINE: ESMF_GridValidate - Validate Grid internals
! !INTERFACE:
subroutine ESMF_GridValidate(grid, keywordEnforcer, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(out), optional :: rc
!
!
! !STATUS:
! \begin{itemize}
! \item\apiStatusCompatibleVersion{5.2.0r}
! \end{itemize}
!
! !DESCRIPTION:
! Validates that the {\tt Grid} is internally consistent.
! Note that one of the checks that the Grid validate does
! is the Grid status. Currently, the validate will return
! an error if the grid is not at least
! {\tt ESMF\_GRIDSTATUS\_COMPLETE}. This means that
! if a Grid was created with the {\tt ESMF\_GridEmptyCreate}
! method, it must also have been finished with
! {\tt ESMF\_GridEmptyComplete()}
! to be valid. If a Grid was created with another create
! call it should automatically have the correct status level
! to pass the status part of the validate.
! The Grid validate at this time doesn't check for the presence
! or consistency of the Grid coordinates.
! The method returns an error code if problems are found.
!
! The arguments are:
! \begin{description}
! \item[grid]
! Specified {\tt ESMF\_Grid} object.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
!------------------------------------------------------------------------------
integer :: localrc ! local return code
! 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_GridGetInit, grid, rc)
! Call into the C++ interface, which will sort out optional arguments.
call c_ESMC_GridValidate(grid, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridValidate
!------------------------------------------------------------------------------
! -------------------------- ESMF-internal method -----------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridGetInit"
!BOPI
! !IROUTINE: ESMF_GridGetInit - Internal access routine for init code
!
! !INTERFACE:
function ESMF_GridGetInit(grid)
!
! !RETURN VALUE:
ESMF_INIT_TYPE :: ESMF_GridGetInit
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in), optional :: grid
!
! !DESCRIPTION:
! Access deep object init code.
!
! The arguments are:
! \begin{description}
! \item [grid]
! Grid object.
! \end{description}
!
!EOPI
if (present(grid)) then
ESMF_GridGetInit = ESMF_INIT_GET(grid)
else
ESMF_GridGetInit = ESMF_INIT_CREATED
endif
end function ESMF_GridGetInit
!------------------------------------------------------------------------------
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridConnEqual"
!BOPI
! !IROUTINE: ESMF_GridConnEqual - Equality of GridConns
!
! !INTERFACE:
impure elemental function ESMF_GridConnEqual(GridConn1, GridConn2)
! !RETURN VALUE:
logical :: ESMF_GridConnEqual
! !ARGUMENTS:
type (ESMF_GridConn_Flag), intent(in) :: &
GridConn1, &! Two igrid statuses to compare for
GridConn2 ! equality
! !DESCRIPTION:
! This routine compares two ESMF GridConn statuses to see if
! they are equivalent.
!
! The arguments are:
! \begin{description}
! \item[GridConn1, GridConn2]
! Two igrid statuses to compare for equality
! \end{description}
!
!EOPI
ESMF_GridConnEqual = (GridConn1%gridconn == &
GridConn2%gridconn)
end function ESMF_GridConnEqual
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridConnNotEqual"
!BOPI
! !IROUTINE: ESMF_GridConnNotEqual - Non-equality of GridConns
!
! !INTERFACE:
impure elemental function ESMF_GridConnNotEqual(GridConn1, GridConn2)
! !RETURN VALUE:
logical :: ESMF_GridConnNotEqual
! !ARGUMENTS:
type (ESMF_GridConn_Flag), intent(in) :: &
GridConn1, &! Two GridConn Statuses to compare for
GridConn2 ! inequality
! !DESCRIPTION:
! This routine compares two ESMF GridConn statuses to see if
! they are unequal.
!
! The arguments are:
! \begin{description}
! \item[GridConn1, GridConn2]
! Two statuses of GridConns to compare for inequality
! \end{description}
!
!EOPI
ESMF_GridConnNotEqual = (GridConn1%gridconn /= &
GridConn2%gridconn)
end function ESMF_GridConnNotEqual
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridDecompEqual"
!BOPI
! !IROUTINE: ESMF_GridDecompEqual - Equality of GridDecomps
!
! !INTERFACE:
impure elemental function ESMF_GridDecompEqual(GridDecomp1, GridDecomp2)
! !RETURN VALUE:
logical :: ESMF_GridDecompEqual
! !ARGUMENTS:
type (ESMF_GridDecompType), intent(in) :: &
GridDecomp1, &! Two igrid statuses to compare for
GridDecomp2 ! equality
! !DESCRIPTION:
! This routine compares two ESMF_GridDecompType statuses to see if
! they are equivalent.
!
! The arguments are:
! \begin{description}
! \item[GridDecomp1, GridDecomp2]
! Two igrid statuses to compare for equality
! \end{description}
!
!EOPI
ESMF_GridDecompEqual = (GridDecomp1%griddecomptype == &
GridDecomp2%griddecomptype)
end function ESMF_GridDecompEqual
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridDecompNotEqual"
!BOPI
! !IROUTINE: ESMF_GridDecompNotEqual - Non-equality of GridDecomps
!
! !INTERFACE:
impure elemental function ESMF_GridDecompNotEqual(GridDecomp1, GridDecomp2)
! !RETURN VALUE:
logical :: ESMF_GridDecompNotEqual
! !ARGUMENTS:
type (ESMF_GridDecompType), intent(in) :: &
GridDecomp1, &! Two GridDecomp Statuses to compare for
GridDecomp2 ! inequality
! !DESCRIPTION:
! This routine compares two ESMF_GridDecompType statuses to see if
! they are unequal.
!
! The arguments are:
! \begin{description}
! \item[GridDecomp1, GridDecomp2]
! Two statuses of GridDecomps to compare for inequality
! \end{description}
!
!EOPI
ESMF_GridDecompNotEqual = (GridDecomp1%griddecomptype /= &
GridDecomp2%griddecomptype)
end function ESMF_GridDecompNotEqual
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridLUADefault"
!BOPI
! !IROUTINE: ESMF_GridLUADefault
! !INTERFACE:
subroutine ESMF_GridLUADefault(dimCount, &
lWidthIn, uWidthIn, alignIn, &
lWidthOut, uWidthOut, alignOut, &
rc)
!
! !ARGUMENTS:
integer, intent(in) :: dimCount
integer, target, intent(in), optional :: lWidthIn(:)
integer, target, intent(in), optional :: uWidthIn(:)
integer, target, intent(in), optional :: alignIn(:)
integer, target, intent(out) :: lWidthOut(:)
integer, target, intent(out) :: uWidthOut(:)
integer, target, intent(out) :: alignOut(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This routine sets the default values of the lwidth, uwidth, and align
! based on the user's passed in values for these.
!
! The arguments are:
! \begin{description}
! \item[{[lWidthIn]}]
! The lower width from the user.
! \item[{[uWidthIn]}]
! The upper width from the user.
! \item[{[alignIn]}]
! The lower width from the user.
! \item[{[lWidthOut]}]
! The lower width based on user input.
! \item[{[uWidthIn]}]
! The upper width based on user input.
! \item[{[alignIn]}]
! The lower width based on user input.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
integer :: localrc ! local error status
type(ESMF_InterArray) :: lWidthInArg ! Language Interface Helper Var
type(ESMF_InterArray) :: uWidthInArg ! Language Interface Helper Var
type(ESMF_InterArray) :: alignInArg ! Language Interface Helper Var
type(ESMF_InterArray) :: lWidthOutArg ! Language Interface Helper Var
type(ESMF_InterArray) :: uWidthOutArg ! Language Interface Helper Var
type(ESMF_InterArray) :: alignOutArg ! Language Interface Helper Var
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check DimCount of gridWidths and Aligns
if (present(lWidthIn)) then
if (size(lWidthIn) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridEdgeLWidth must be of size equal to Grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(uWidthIn)) then
if (size(uWidthIn) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridEdgeUWidth must be of size equal to Grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(alignIn)) then
if (size(alignIn) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridAlign must be of size equal to Grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! turn to InterArray
lWidthInArg = ESMF_InterArrayCreate(lWidthIn, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
uWidthInArg = ESMF_InterArrayCreate(uWidthIn, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
alignInArg = ESMF_InterArrayCreate(alignIn, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
lWidthOutArg = ESMF_InterArrayCreate(lWidthOut, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
uWidthOutArg = ESMF_InterArrayCreate(uWidthOut, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
alignOutArg = ESMF_InterArrayCreate(alignOut, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Call C++ Subroutine for the default
call c_ESMC_gridluadefault(dimCount, &
lWidthInArg, uWidthInArg, alignInArg, &
lWidthOutArg, uWidthOutArg, alignOutArg, &
localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Deallocate helper variables
call ESMF_InterArrayDestroy(lWidthInArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(uWidthInArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(alignInArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(lWidthOutArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(uWidthOutArg, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_InterArrayDestroy(alignOutArg, 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_GridLUADefault
!------------------------------------------------------------------------------
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridLUA1PeriDim"
!BOPI
! !IROUTINE: ESMF_GridLUA1PeriDim
! !INTERFACE:
subroutine ESMF_GridLUA1PeriDim(dimCount, periodicDim, &
lWidthIn, uWidthIn, alignIn, &
lWidthOut, uWidthOut, alignOut, &
rc)
!
! !ARGUMENTS:
integer, intent(in) :: dimCount
integer, intent(in) :: periodicDim
integer, target, intent(in), optional :: lWidthIn(:)
integer, target, intent(in), optional :: uWidthIn(:)
integer, target, intent(in), optional :: alignIn(:)
integer, target, intent(out) :: lWidthOut(:)
integer, target, intent(out) :: uWidthOut(:)
integer, target, intent(out) :: alignOut(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This routine sets the default values of the lwidth, uwidth, and align
! based on the user's passed in values for these.
!
! The arguments are:
! \begin{description}
! \item[{[lWidthIn]}]
! The lower width from the user.
! \item[{[uWidthIn]}]
! The upper width from the user.
! \item[{[alignIn]}]
! The lower width from the user.
! \item[{[lWidthOut]}]
! The lower width based on user input.
! \item[{[uWidthIn]}]
! The upper width based on user input.
! \item[{[alignIn]}]
! The lower width based on user input.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
integer :: localrc ! local error status
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check DimCount of gridWidths and Aligns
if (present(lWidthIn)) then
if (size(lWidthIn) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridEdgeLWidth must be of size equal to Grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (lWidthIn(periodicDim) /= 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridEdgeLWidth must be of size 0 on the periodic dimension", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(uWidthIn)) then
if (size(uWidthIn) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridEdgeUWidth must be of size equal to Grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (uWidthIn(periodicDim) /= 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridEdgeUWidth must be of size 0 on the periodic dimension", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
call ESMF_GridLUADefault(dimCount, &
lWidthIn, uWidthIn, alignIn, &
lWidthOut, uWidthOut, alignOut, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Make default 0 for periodic dimension
lWidthOut(periodicDim)=0
uWidthOut(periodicDim)=0
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridLUA1PeriDim
!------------------------------------------------------------------------------
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridLUA2PeriDim"
!BOPI
! !IROUTINE: ESMF_GridLUA2PeriDim
! !INTERFACE:
subroutine ESMF_GridLUA2PeriDim(dimCount, &
periodicDim1, periodicDim2, &
lWidthIn, uWidthIn, alignIn, &
lWidthOut, uWidthOut, alignOut, &
rc)
!
! !ARGUMENTS:
integer, intent(in) :: dimCount
integer, intent(in) :: periodicDim1
integer, intent(in) :: periodicDim2
integer, target, intent(in), optional :: lWidthIn(:)
integer, target, intent(in), optional :: uWidthIn(:)
integer, target, intent(in), optional :: alignIn(:)
integer, target, intent(out) :: lWidthOut(:)
integer, target, intent(out) :: uWidthOut(:)
integer, target, intent(out) :: alignOut(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
! This routine sets the default values of the lwidth, uwidth, and align
! based on the user's passed in values for these.
!
! The arguments are:
! \begin{description}
! \item[{[lWidthIn]}]
! The lower width from the user.
! \item[{[uWidthIn]}]
! The upper width from the user.
! \item[{[alignIn]}]
! The lower width from the user.
! \item[{[lWidthOut]}]
! The lower width based on user input.
! \item[{[uWidthIn]}]
! The upper width based on user input.
! \item[{[alignIn]}]
! The lower width based on user input.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
integer :: localrc ! local error status
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Check DimCount of gridWidths and Aligns
if (present(lWidthIn)) then
if (size(lWidthIn) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridEdgeLWidth must be of size equal to Grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (lWidthIn(periodicDim1) /= 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridEdgeLWidth must be of size 0 on a periodic dimension", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (lWidthIn(periodicDim2) /= 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridEdgeLWidth must be of size 0 on a periodic dimension", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(uWidthIn)) then
if (size(uWidthIn) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridEdgeUWidth must be of size equal to Grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (uWidthIn(periodicDim1) /= 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridEdgeUWidth must be of size 0 on a periodic dimension", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (uWidthIn(periodicDim2) /= 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- gridEdgeUWidth must be of size 0 on a periodic dimension", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
call ESMF_GridLUADefault(dimCount, &
lWidthIn, uWidthIn, alignIn, &
lWidthOut, uWidthOut, alignOut, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Make default 0 for periodic dimension
lWidthOut(periodicDim1)=0
lWidthOut(periodicDim2)=0
uWidthOut(periodicDim1)=0
uWidthOut(periodicDim2)=0
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridLUA2PeriDim
!------------------------------------------------------------------------------
! --------------------------------------------- -------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridSetDestroyDistgrid()"
!BOPI
! !IROUTINE: ESMF_GridSetDestroyDistgrid
! !INTERFACE:
subroutine ESMF_GridSetDestroyDistgrid(grid,destroy, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
logical, intent(in) :: destroy
integer, intent(out), optional :: rc
!
!
! !DESCRIPTION:
!
!EOPI
!------------------------------------------------------------------------------
integer :: localrc ! local return code
integer :: destroyInt
! 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_GridGetInit, grid, rc)
! set int from logical
if (destroy) then
destroyInt=1
else
destroyInt=0
endif
! Call into the C++ interface, which will sort out optional arguments.
call c_esmc_gridsetdestroydistgrid(grid, destroyInt);
! return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridSetDestroyDistgrid
!------------------------------------------------------------------------------
! --------------------------------------------- -------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridSetDestroyDELayout()"
!BOPI
! !IROUTINE: ESMF_GridSetDestroyDELayout
! !INTERFACE:
subroutine ESMF_GridSetDestroyDELayout(grid,destroy, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
logical, intent(in) :: destroy
integer, intent(out), optional :: rc
!
!
! !DESCRIPTION:
!
!EOPI
!------------------------------------------------------------------------------
integer :: localrc ! local return code
integer :: destroyInt
! 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_GridGetInit, grid, rc)
! set int from logical
if (destroy) then
destroyInt=1
else
destroyInt=0
endif
! Call into the C++ interface, which will sort out optional arguments.
call c_esmc_gridsetdestroydelayout(grid, destroyInt);
! return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridSetDestroyDELayout
!------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridStatusAssignment"
!BOPI
! !IROUTINE: ESMF_GridStatusAssignment - Assign the string value
!
! !INTERFACE:
! Private name; call using assignment(=)
subroutine ESMF_GridStatusAssignment(string, gsval)
! !ARGUMENTS:
character(len=*), intent(out) :: string
type(ESMF_GridStatus_Flag), intent(in) :: gsval
! !DESCRIPTION:
! Assign the string value of an ESMF_GridStatus_Flag
!
!EOPI
!-------------------------------------------------------------------------------
if (gsval == ESMF_GRIDSTATUS_INVALID) then
write(string,'(a)') 'ESMF_GRIDSTATUS_INVALID'
elseif (gsval == ESMF_GRIDSTATUS_UNINIT) then
write(string,'(a)') 'ESMF_GRIDSTATUS_UNINIT'
elseif (gsval == ESMF_GRIDSTATUS_EMPTY) then
write(string,'(a)') 'ESMF_GRIDSTATUS_EMPTY'
elseif (gsval == ESMF_GRIDSTATUS_COMPLETE) then
write(string,'(a)') 'ESMF_GRIDSTATUS_COMPLETE'
endif
end subroutine ESMF_GridStatusAssignment
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridStatusEqual"
!BOPI
! !IROUTINE: ESMF_GridStatusEqual - Equality of GridStatus statuses
!
! !INTERFACE:
impure elemental function ESMF_GridStatusEqual(GridStatus1, GridStatus2)
! !RETURN VALUE:
logical :: ESMF_GridStatusEqual
! !ARGUMENTS:
type (ESMF_GridStatus_Flag), intent(in) :: &
GridStatus1, &! Two igrid statuses to compare for
GridStatus2 ! equality
! !DESCRIPTION:
! This routine compares two ESMF GridStatus statuses to see if
! they are equivalent.
!
! The arguments are:
! \begin{description}
! \item[GridStatus1, GridStatus2]
! Two igrid statuses to compare for equality
! \end{description}
!
!EOPI
ESMF_GridStatusEqual = (GridStatus1%gridstatus == &
GridStatus2%gridstatus)
end function ESMF_GridStatusEqual
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridStatusNotEqual"
!BOPI
! !IROUTINE: ESMF_GridStatusNotEqual - Non-equality of GridStatus statuses
!
! !INTERFACE:
impure elemental function ESMF_GridStatusNotEqual(GridStatus1, GridStatus2)
! !RETURN VALUE:
logical :: ESMF_GridStatusNotEqual
! !ARGUMENTS:
type (ESMF_GridStatus_Flag), intent(in) :: &
GridStatus1, &! Two GridStatus Statuses to compare for
GridStatus2 ! inequality
! !DESCRIPTION:
! This routine compares two ESMF GridStatus statuses to see if
! they are unequal.
!
! The arguments are:
! \begin{description}
! \item[GridStatus1, GridStatus2]
! Two statuses of GridStatuss to compare for inequality
! \end{description}
!
!EOPI
ESMF_GridStatusNotEqual = (GridStatus1%gridstatus /= &
GridStatus2%gridstatus)
end function ESMF_GridStatusNotEqual
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridStatusGreater"
!BOPI
! !IROUTINE: ESMF_GridStatusGreater - Equality of GridStatus statuses
!
! !INTERFACE:
function ESMF_GridStatusGreater(GridStatus1, GridStatus2)
! !RETURN VALUE:
logical :: ESMF_GridStatusGreater
! !ARGUMENTS:
type (ESMF_GridStatus_Flag), intent(in) :: &
GridStatus1, &! Two igrid statuses to compare for
GridStatus2 ! equality
! !DESCRIPTION:
! This routine compares two ESMF GridStatus statuses to see if
! they are equivalent.
!
! The arguments are:
! \begin{description}
! \item[GridStatus1, GridStatus2]
! Two igrid statuses to compare for equality
! \end{description}
!
!EOPI
ESMF_GridStatusGreater = (GridStatus1%gridstatus > &
GridStatus2%gridstatus)
end function ESMF_GridStatusGreater
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridStatusLess"
!BOPI
! !IROUTINE: ESMF_GridStatusLess - Non-equality of GridStatus statuses
!
! !INTERFACE:
function ESMF_GridStatusLess(GridStatus1, GridStatus2)
! !RETURN VALUE:
logical :: ESMF_GridStatusLess
! !ARGUMENTS:
type (ESMF_GridStatus_Flag), intent(in) :: &
GridStatus1, &! Two GridStatus Statuses to compare for
GridStatus2 ! inequality
! !DESCRIPTION:
! This routine compares two ESMF GridStatus statuses to see if
! they are unequal.
!
! The arguments are:
! \begin{description}
! \item[GridStatus1, GridStatus2]
! Two statuses of GridStatuss to compare for inequality
! \end{description}
!
!EOPI
ESMF_GridStatusLess = (GridStatus1%gridstatus .lt. &
GridStatus2%gridstatus)
end function ESMF_GridStatusLess
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridStatusGreaterEqual"
!BOPI
! !IROUTINE: ESMF_GridStatusGreaterEqual - Greater than or equal of GridStatus statuses
!
! !INTERFACE:
function ESMF_GridStatusGreaterEqual(GridStatus1, GridStatus2)
! !RETURN VALUE:
logical :: ESMF_GridStatusGreaterEqual
! !ARGUMENTS:
type (ESMF_GridStatus_Flag), intent(in) :: &
GridStatus1, &! Two igrid statuses to compare for
GridStatus2 ! equality
! !DESCRIPTION:
! This routine compares two ESMF GridStatus statuses to see if
! they are equivalent.
!
! The arguments are:
! \begin{description}
! \item[GridStatus1, GridStatus2]
! Two igrid statuses to compare
! \end{description}
!
!EOPI
ESMF_GridStatusGreaterEqual = (GridStatus1%gridstatus >= &
GridStatus2%gridstatus)
end function ESMF_GridStatusGreaterEqual
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridStatusLessEqual"
!BOPI
! !IROUTINE: ESMF_GridStatusLessEqual - Less than or equal of GridStatus statuses
!
! !INTERFACE:
function ESMF_GridStatusLessEqual(GridStatus1, GridStatus2)
! !RETURN VALUE:
logical :: ESMF_GridStatusLessEqual
! !ARGUMENTS:
type (ESMF_GridStatus_Flag), intent(in) :: &
GridStatus1, &! Two GridStatus Statuses to compare for
GridStatus2 ! inequality
! !DESCRIPTION:
! This routine compares two ESMF GridStatus statuses to see if
! they are unequal.
!
! The arguments are:
! \begin{description}
! \item[GridStatus1, GridStatus2]
! Two statuses of GridStatuss to compare
! \end{description}
!
!EOPI
ESMF_GridStatusLessEqual = (GridStatus1%gridstatus .le. &
GridStatus2%gridstatus)
end function ESMF_GridStatusLessEqual
!! GRIDMATCH
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridMatchEqual"
!BOPI
! !IROUTINE: ESMF_GridMatchEqual - Equality of GridMatch statuses
!
! !INTERFACE:
impure elemental function ESMF_GridMatchEqual(GridMatch1, GridMatch2)
! !RETURN VALUE:
logical :: ESMF_GridMatchEqual
! !ARGUMENTS:
type (ESMF_GridMatch_Flag), intent(in) :: &
GridMatch1, &! Two igrid statuses to compare for
GridMatch2 ! equality
! !DESCRIPTION:
! This routine compares two ESMF GridMatch statuses to see if
! they are equivalent.
!
! The arguments are:
! \begin{description}
! \item[GridMatch1, GridMatch2]
! Two igrid statuses to compare for equality
! \end{description}
!
!EOPI
ESMF_GridMatchEqual = (GridMatch1%gridmatch == &
GridMatch2%gridmatch)
end function ESMF_GridMatchEqual
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridMatchNotEqual"
!BOPI
! !IROUTINE: ESMF_GridMatchNotEqual - Non-equality of GridMatch statuses
!
! !INTERFACE:
impure elemental function ESMF_GridMatchNotEqual(GridMatch1, GridMatch2)
! !RETURN VALUE:
logical :: ESMF_GridMatchNotEqual
! !ARGUMENTS:
type (ESMF_GridMatch_Flag), intent(in) :: &
GridMatch1, &! Two GridMatch Statuses to compare for
GridMatch2 ! inequality
! !DESCRIPTION:
! This routine compares two ESMF GridMatch statuses to see if
! they are unequal.
!
! The arguments are:
! \begin{description}
! \item[GridMatch1, GridMatch2]
! Two statuses of GridMatchs to compare for inequality
! \end{description}
!
!EOPI
ESMF_GridMatchNotEqual = (GridMatch1%gridmatch /= &
GridMatch2%gridmatch)
end function ESMF_GridMatchNotEqual
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridMatchGreater"
!BOPI
! !IROUTINE: ESMF_GridMatchGreater - Equality of GridMatch statuses
!
! !INTERFACE:
function ESMF_GridMatchGreater(GridMatch1, GridMatch2)
! !RETURN VALUE:
logical :: ESMF_GridMatchGreater
! !ARGUMENTS:
type (ESMF_GridMatch_Flag), intent(in) :: &
GridMatch1, &! Two igrid statuses to compare for
GridMatch2 ! equality
! !DESCRIPTION:
! This routine compares two ESMF GridMatch statuses to see if
! they are equivalent.
!
! The arguments are:
! \begin{description}
! \item[GridMatch1, GridMatch2]
! Two igrid statuses to compare for equality
! \end{description}
!
!EOPI
ESMF_GridMatchGreater = (GridMatch1%gridmatch > &
GridMatch2%gridmatch)
end function ESMF_GridMatchGreater
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridMatchLess"
!BOPI
! !IROUTINE: ESMF_GridMatchLess - Non-equality of GridMatch statuses
!
! !INTERFACE:
function ESMF_GridMatchLess(GridMatch1, GridMatch2)
! !RETURN VALUE:
logical :: ESMF_GridMatchLess
! !ARGUMENTS:
type (ESMF_GridMatch_Flag), intent(in) :: &
GridMatch1, &! Two GridMatch Statuses to compare for
GridMatch2 ! inequality
! !DESCRIPTION:
! This routine compares two ESMF GridMatch statuses to see if
! they are unequal.
!
! The arguments are:
! \begin{description}
! \item[GridMatch1, GridMatch2]
! Two statuses of GridMatchs to compare for inequality
! \end{description}
!
!EOPI
ESMF_GridMatchLess = (GridMatch1%gridmatch .lt. &
GridMatch2%gridmatch)
end function ESMF_GridMatchLess
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridMatchGreaterEqual"
!BOPI
! !IROUTINE: ESMF_GridMatchGreaterEqual - Greater than or equal of GridMatch statuses
!
! !INTERFACE:
function ESMF_GridMatchGreaterEqual(GridMatch1, GridMatch2)
! !RETURN VALUE:
logical :: ESMF_GridMatchGreaterEqual
! !ARGUMENTS:
type (ESMF_GridMatch_Flag), intent(in) :: &
GridMatch1, &! Two igrid statuses to compare for
GridMatch2 ! equality
! !DESCRIPTION:
! This routine compares two ESMF GridMatch statuses to see if
! they are equivalent.
!
! The arguments are:
! \begin{description}
! \item[GridMatch1, GridMatch2]
! Two igrid statuses to compare
! \end{description}
!
!EOPI
ESMF_GridMatchGreaterEqual = (GridMatch1%gridmatch >= &
GridMatch2%gridmatch)
end function ESMF_GridMatchGreaterEqual
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridMatchLessEqual"
!BOPI
! !IROUTINE: ESMF_GridMatchLessEqual - Less than or equal of GridMatch statuses
!
! !INTERFACE:
function ESMF_GridMatchLessEqual(GridMatch1, GridMatch2)
! !RETURN VALUE:
logical :: ESMF_GridMatchLessEqual
! !ARGUMENTS:
type (ESMF_GridMatch_Flag), intent(in) :: &
GridMatch1, &! Two GridMatch Statuses to compare for
GridMatch2 ! inequality
! !DESCRIPTION:
! This routine compares two ESMF GridMatch statuses to see if
! they are unequal.
!
! The arguments are:
! \begin{description}
! \item[GridMatch1, GridMatch2]
! Two statuses of GridMatchs to compare
! \end{description}
!
!EOPI
ESMF_GridMatchLessEqual = (GridMatch1%gridmatch .le. &
GridMatch2%gridmatch)
end function ESMF_GridMatchLessEqual
#if 0
! -------------------------- ESMF-public method -------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridTest()"
!BOPI
! !IROUTINE: ESMF_GridTest - Test Grid internals
! !INTERFACE:
subroutine ESMF_GridTest(grid, rc)
!
! !ARGUMENTS:
type(ESMF_Grid), intent(in) :: grid
integer, intent(out), optional :: rc
!
!
! !DESCRIPTION:
! TEST SUBROUTINE FOR INTERNAL ESMF USE ONLY
!
!EOPI
!------------------------------------------------------------------------------
integer :: localrc ! local return code
! 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_GridGetInit, grid, rc)
! Call into the C++ interface, which will sort out optional arguments.
call c_ESMC_GridTest(grid, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine ESMF_GridTest
!------------------------------------------------------------------------------
#endif
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateDistgridIrreg"
!BOPI
! !IROUTINE: ESMF_GridCreateDistgridIrreg - an internal routine to create a irreg distgrid
! !INTERFACE:
function ESMF_GridCreateDistgridIrreg(dimCount, &
minIndex, maxIndex, &
countsPerDEDim1,countsPerDeDim2, &
countsPerDEDim3, &
indexflag, petMap, connList, rc)
!
! !RETURN VALUE:
type(ESMF_DistGrid) :: ESMF_GridCreateDistgridIrreg
!
! !ARGUMENTS:
integer, intent(in) :: dimCount
integer, intent(in) :: minIndex(:)
integer, intent(in) :: maxIndex(:)
integer, intent(in) :: countsPerDEDim1(:)
integer, intent(in) :: countsPerDEDim2(:)
integer, intent(in), optional :: countsPerDEDim3(:)
type(ESMF_Index_Flag), intent(in), optional :: indexflag
integer, intent(in), optional :: petMap(:,:,:)
type(ESMF_DistgridConnection), intent(in), optional :: connList(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This is an internal method to create a single tile, irregularly distributed distgrid
! (see Figure \ref{fig:GridDecomps}).
! To specify the irregular distribution, the user passes in an array
! for each grid dimension, where the length of the array is the number
! of DEs in the dimension. Up to three dimensions can be specified,
! using the countsPerDEDim1, countsPerDEDim2, countsPerDEDim3 arguments.
! The index of each array element corresponds to a DE number. The
! array value at the index is the number of grid cells on the DE in
! that dimension. The dimCount of the grid is equal to the number of
! countsPerDEDim arrays that are specified.
!
! Section \ref{example:2DIrregUniGrid} shows an example
! of using this method to create a 2D Grid with uniformly spaced
! coordinates. This creation method can also be used as the basis for
! grids with rectilinear coordinates or curvilinear coordinates.
!
! The arguments are:
! \begin{description}
! \item[{minIndex}]
! Tuple to start the index ranges at. If not present, defaults
! to /1,1,1,.../.
! \item[{maxIndex}]
! Tuple to end the index ranges at.
! \item[{countsPerDEDim1}]
! This arrays specifies the number of cells per DE for index dimension 1
! for the exclusive region (the center stagger location).
! \item[{countsPerDEDim2}]
! This array specifies the number of cells per DE for index dimension 2
! for the exclusive region (center stagger location).
! \item[{[countsPerDEDim3]}]
! This array specifies the number of cells per DE for index dimension 3
! for the exclusive region (center stagger location).
! If not specified then grid is 2D.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[petMap]}]
! \begin{sloppypar}
! Sets the mapping of pets to the created DEs. This 3D
! should be of size size(countsPerDEDim1) x size(countsPerDEDim2) x
! size(countsPerDEDim3). If countsPerDEDim3 isn't present, then
! the last dimension is of size 1.
! \end{sloppypar}
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
type(ESMF_DistGrid) :: distgrid
type(ESMF_DELayout) :: delayout
integer, pointer :: petList(:)
integer :: localrc
integer :: i,maxSizeDEDim
integer, pointer :: deDimCount(:)
integer, pointer :: countsPerDEDim1Local(:)
integer, pointer :: countsPerDEDim2Local(:)
integer, pointer :: countsPerDEDim3Local(:)
integer, pointer :: deBlockList(:,:,:),minPerDEDim(:,:),maxPerDEDim(:,:)
integer :: deCount
integer :: d,i1,i2,i3,k
integer :: top
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! error checking
if (present(petMap)) then
if (dimCount > 2) then
if ((size(petMap,1) /= size(countsPerDEDim1)) .or. &
(size(petMap,2) /= size(countsPerDEDim2)) .or. &
(size(petMap,3) /= size(countsPerDEDim3))) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- petMap wrong size in one or more dimensions", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else
if ((size(petMap,1) /= size(countsPerDEDim1)) .or. &
(size(petMap,2) /= size(countsPerDEDim2)) .or. &
(size(petMap,3) /= 1)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- petMap wrong size in one or more dimensions", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
! Copy vales for countsPerDEDim --------------------------------------------
allocate(countsPerDEDim1Local(size(countsPerDEDim1)), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating countsPerDEDim1Local", &
ESMF_CONTEXT, rcToReturn=rc)) return
countsPerDEDim1Local=countsPerDEDim1
allocate(countsPerDEDim2Local(size(countsPerDEDim2)), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating countsPerDEDim2Local", &
ESMF_CONTEXT, rcToReturn=rc)) return
countsPerDEDim2Local=countsPerDEDim2
if (dimCount > 2) then
allocate(countsPerDEDim3Local(size(countsPerDEDim3)), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating countsPerDEDim3Local", &
ESMF_CONTEXT, rcToReturn=rc)) return
countsPerDEDim3Local=countsPerDEDim3
endif
! Setup deBlockList for DistGrid ------------------------------------------------
! count de blocks
deCount=1
deCount=deCount*size(countsPerDEDim1Local)
deCount=deCount*size(countsPerDEDim2Local)
if (dimCount > 2) then
deCount=deCount*size(countsPerDEDim3Local)
endif
! Calc the max size of a DEDim
maxSizeDEDim=1
if (size(countsPerDEDim1Local) > maxSizeDEDim) then
maxSizeDEDim=size(countsPerDEDim1Local)
endif
if (size(countsPerDEDim2Local) > maxSizeDEDim) then
maxSizeDEDim=size(countsPerDEDim2Local)
endif
if (dimCount > 2) then
if (size(countsPerDEDim3Local) > maxSizeDEDim) then
maxSizeDEDim=size(countsPerDEDim3Local)
endif
endif
! generate deblocklist
allocate(maxPerDEDim(dimCount,maxSizeDEDim), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxPerDEDim", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(minPerDEDim(dimCount,maxSizeDEDim), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minPerDEDim", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(deDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxPerDEDim", &
ESMF_CONTEXT, rcToReturn=rc)) return
! Calc the maximum end of each DE in a Dim, and the size of each DEDim
d=1
deDimCount(d)=size(countsPerDEDim1Local)
minPerDeDim(d,1)=minIndex(d)
maxPerDeDim(d,1)=minIndex(d)+countsPerDEDim1Local(1)-1
do i=2,deDimCount(d)
minPerDEDim(d,i)=maxPerDEDim(d,i-1)+1
maxPerDEDim(d,i)=minPerDEDim(d,i)+countsPerDEDim1Local(i)-1
enddo
d=2
deDimCount(d)=size(countsPerDEDim2Local)
minPerDeDim(d,1)=minIndex(d)
maxPerDeDim(d,1)=minIndex(d)+countsPerDEDim2Local(1)-1
do i=2,deDimCount(d)
minPerDEDim(d,i)=maxPerDEDim(d,i-1)+1
maxPerDEDim(d,i)=minPerDEDim(d,i)+countsPerDEDim2Local(i)-1
enddo
if (dimCount > 2) then
d=3
deDimCount(d)=size(countsPerDEDim3Local)
minPerDeDim(d,1)=minIndex(d)
maxPerDeDim(d,1)=minIndex(d)+countsPerDEDim3Local(1)-1
do i=2,deDimCount(d)
minPerDEDim(d,i)=maxPerDEDim(d,i-1)+1
maxPerDEDim(d,i)=minPerDEDim(d,i)+countsPerDEDim3Local(i)-1
enddo
endif
! allocate deblocklist
allocate(deBlockList(dimCount,2,deCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating deBlockList", &
ESMF_CONTEXT, rcToReturn=rc)) return
! Fill in DeBlockList
if (dimCount == 2) then
k=1
do i2=1,deDimCount(2)
do i1=1,deDimCount(1)
deBlockList(1,1,k)=minPerDEDim(1,i1)
deBlockList(1,2,k)=maxPerDEDim(1,i1)
deBlockList(2,1,k)=minPerDEDim(2,i2)
deBlockList(2,2,k)=maxPerDEDim(2,i2)
k=k+1
enddo
enddo
else if (dimCount == 3) then
k=1
do i3=1,deDimCount(3)
do i2=1,deDimCount(2)
do i1=1,deDimCount(1)
deBlockList(1,1,k)=minPerDEDim(1,i1)
deBlockList(1,2,k)=maxPerDEDim(1,i1)
deBlockList(2,1,k)=minPerDEDim(2,i2)
deBlockList(2,2,k)=maxPerDEDim(2,i2)
deBlockList(3,1,k)=minPerDEDim(3,i3)
deBlockList(3,2,k)=maxPerDEDim(3,i3)
k=k+1
enddo
enddo
enddo
endif
! do i=1,deCount
! write(*,*) i,"min=",deBlockList(:,1,i)," max=",deBlockList(:,2,i)
! enddo
! Process PetMap --------------------------------------------------------------
if (present(petMap)) then
!! Allocate petList
allocate(petList(deCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating petList", &
ESMF_CONTEXT, rcToReturn=rc)) return
!! copy petMap to petList
if (dimCount > 2) then
k=1
do i3=1,size(countsPerDEDim3Local)
do i2=1,size(countsPerDEDim2Local)
do i1=1,size(countsPerDEDim1Local)
petList(k)=petMap(i1,i2,i3)
k=k+1
enddo
enddo
enddo
else
k=1
do i3=1,1
do i2=1,size(countsPerDEDim2Local)
do i1=1,size(countsPerDEDim1Local)
petList(k)=petMap(i1,i2,i3)
k=k+1
enddo
enddo
enddo
endif
!! create delayout from the petList
delayout=ESMF_DELayoutCreate(petMap=petList,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! Get rid of list
deallocate(petList)
else
!! create a default delayout
delayout=ESMF_DELayoutCreate(deCount=deCount,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Create DistGrid --------------------------------------------------------------
ESMF_GridCreateDistgridIrreg=ESMF_DistGridCreate(minIndex=minIndex, maxIndex=maxIndex, &
deBlockList=deBlockList, delayout=delayout, indexflag=indexflag, &
connectionList=connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(maxPerDEDim)
deallocate(minPerDEDim)
deallocate(deDimCount)
deallocate(deBlockList)
deallocate(countsPerDEDim1Local)
deallocate(countsPerDEDim2Local)
if (dimCount > 2) then
deallocate(countsPerDEDim3Local)
endif
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreateDistgridIrreg
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "GetIndexSpaceIrreg"
!BOPI
! !IROUTINE: GetIndexSpaceIrreg - get the dimcount, min and max index
! !INTERFACE:
subroutine GetIndexSpaceIrreg(minIndex, &
countsPerDEDim1,countsPerDeDim2, &
countsPerDEDim3, dimCount, minIndexOut, maxIndexOut, rc)
!!
! !ARGUMENTS:
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: countsPerDEDim1(:)
integer, intent(in) :: countsPerDEDim2(:)
integer, intent(in), optional :: countsPerDEDim3(:)
integer, intent(inout) :: dimCount
integer, pointer :: minIndexOut(:)
integer, pointer :: maxIndexOut(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This is a routine to calculate the minIndex and maxIndex of an irregular distribution.
! The arguments are:
! \begin{description}
! \item[{[minIndex]}]
! Tuple to start the index ranges at. If not present, defaults
! to /1,1,1,.../.
! \item[{countsPerDEDim1}]
! This arrays specifies the number of cells per DE for index dimension 1
! for the exclusive region (the center stagger location).
! \item[{countsPerDEDim2}]
! This array specifies the number of cells per DE for index dimension 2
! for the exclusive region (center stagger location).
! \item[{[countsPerDEDim3]}]
! This array specifies the number of cells per DE for index dimension 3
! for the exclusive region (center stagger location).
! If not specified then grid is 2D.
! \item[{minIndexOut}]
! MinIndex of range, needs to be allocated to dimCount.
! \item[{maxIndexOut}]
! MaxIndex of range, needs to be allocated to dimCount.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
integer :: localrc
integer :: i
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Compute the Grid DimCount
! dimCount
if (present(countsPerDEDim3)) then
dimCount=3
else
dimCount=2
endif
! Argument Consistency Checking
if (size(countsPerDEDim1) .lt. 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- size 0 countsPerDEDim1 not allowed", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (size(countsPerDEDim2) .lt. 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- size 0 countsPerDEDim2 not allowed", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (present(countsPerDEDim3)) then
if (size(countsPerDEDim3) .lt. 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- size 0 countsPerDEDim3 not allowed", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(minIndex)) then
if (size(minIndex) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- minIndex size must equal grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! Allocate minIndex
allocate(minIndexOut(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndexOut", &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set minIndex
if (present(minIndex)) then
minIndexOut(:)=minIndex(:)
else
do i=1,dimCount
minIndexOut(i)=1
enddo
endif
! Allocate maxIndex
allocate(maxIndexOut(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxIndexOut", &
ESMF_CONTEXT, rcToReturn=rc)) return
! Set maxIndex
maxIndexOut(1)=sum(countsPerDEDim1)+minIndexOut(1)-1
maxIndexOut(2)=sum(countsPerDEDim2)+minIndexOut(2)-1
if (dimCount > 2) then
maxIndexOut(3)=sum(countsPerDEDim3)+minIndexOut(3)-1
endif
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine GetIndexSpaceIrreg
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateDistgridReg"
!BOPI
! !IROUTINE: ESMF_GridCreateDistgrid - Create a Distgrid with a regular distribution
! !INTERFACE:
function ESMF_GridCreateDistgridReg(dimCount, minIndex, maxIndex, regDecomp, decompFlag, &
indexflag, petMap, connList, rc)
!
! !RETURN VALUE:
type(ESMF_Distgrid) :: ESMF_GridCreateDistgridReg
!
! !ARGUMENTS:
integer :: dimCount
integer, intent(in) :: minIndex(:)
integer, intent(in) :: maxIndex(:)
integer, intent(in), optional :: regDecomp(:)
type(ESMF_Decomp_Flag), intent(in), optional :: decompflag(:)
type(ESMF_Index_Flag), intent(in), optional :: indexflag
integer, intent(in), optional :: petMap(:,:,:)
type(ESMF_DistgridConnection), intent(in), optional :: connList(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This internal method creates a single tile, regularly distributed distgrid
! (see Figure \ref{fig:GridDecomps}).
! To specify the distribution, the user passes in an array
! ({\tt regDecomp}) specifying the number of DEs to divide each
! dimension into. The array {\tt decompFlag} indicates how the division into DEs is to
! occur. The default is to divide the range as evenly as possible.
!
! The arguments are:
! \begin{description}
! \item[{[regDecomp]}]
! List that has the same number of elements as {\tt maxIndex}.
! Each entry is the number of decounts for that dimension.
! If not specified, the default decomposition will be petCountx1x1..x1.
! \item[{[decompflag]}]
! List of decomposition flags indicating how each dimension of the
! tile is to be divided between the DEs. The default setting
! is {\tt ESMF\_DECOMP\_BALANCED} in all dimensions. Please see
! Section~\ref{const:decompflag} for a full description of the
! possible options. Note that currently the option
! {\tt ESMF\_DECOMP\_CYCLIC} isn't supported in Grid creation.
! \item[{minIndex}]
! The bottom extent of the grid array. If not given then the value defaults
! to /1,1,1,.../.
! \item[{maxIndex}]
! The upper extent of the grid array.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[petMap]}]
! Sets the mapping of pets to the created DEs. This 3D
! should be of size regDecomp(1) x regDecomp(2) x regDecomp(3)
! If the Grid is 2D, then the last dimension is of size 1.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
type(ESMF_DELayout) :: delayout
type(ESMF_VM) :: vm
integer, pointer :: petList(:)
integer :: localrc
integer :: i
integer, pointer :: regDecompLocal(:)
type(ESMF_Decomp_Flag), pointer :: decompflagLocal(:)
integer, pointer :: minIndexLocal(:), maxIndexLocal(:)
integer :: deCount
integer :: i1,i2,i3,k
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Argument Consistency Checking --------------------------------------------------------------
if (present(regDecomp)) then
if (size(regDecomp) .lt. dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- regDecomp size doesn't match Grid dimCount ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(decompFlag)) then
! Make sure size is correct
if (size(decompFlag) .lt. dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- decompFlag size doesn't match Grid dimCount ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! CYCLIC decomposition isn't allowed when creating a Grid
do i=1,size(decompFlag)
if (decompFlag(i) == ESMF_DECOMP_CYCLIC) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_OUTOFRANGE, &
msg="- decompFlag isn't allowed to be" // &
" ESMF_DECOMP_CYCLIC when creating a Grid.", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
enddo
endif
! Set default for regDecomp
allocate(regDecompLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating regDecompLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(regDecomp)) then
regDecompLocal(:)=regDecomp(:)
else
! The default is 1D divided among all the Pets
call ESMF_VMGetCurrent(vm,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_VMGet(vm,petCount=regDecompLocal(1),rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
do i=2,dimCount
regDecompLocal(i)=1
enddo
endif
if (present(petMap)) then
if (dimCount > 2) then
if ((size(petMap,1) /= regDecompLocal(1)) .or. &
(size(petMap,2) /= regDecompLocal(2)) .or. &
(size(petMap,3) /= regDecompLocal(3))) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- petMap wrong size in one or more dimensions", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else
if ((size(petMap,1) /= regDecompLocal(1)) .or. &
(size(petMap,2) /= regDecompLocal(2)) .or. &
(size(petMap,3) /= 1)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- petMap wrong size in one or more dimensions", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
! Set default for decomp flag based on gridEdgeWidths -----------------------------------
! NOTE: This is a temporary fix until we have something better implemented in distGrid
! Set default for decompFlag
allocate(decompFlagLocal(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating decompFlagLocal", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(decompFlag)) then
decompFlagLocal(:)=decompFlag(:)
else
decompFlagLocal(:)=ESMF_DECOMP_BALANCED
endif
! Process PetMap --------------------------------------------------------------
!! Calculate deCount
deCount=1
do i=1,dimCount
deCount=deCount*regDecompLocal(i)
enddo
! create DELayout based on presence of petMap
if (present(petMap)) then
!! Allocate petList
allocate(petList(deCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating petList", &
ESMF_CONTEXT, rcToReturn=rc)) return
!! copy petMap to petList
if (dimCount > 2) then
k=1
do i3=1,regDecompLocal(3)
do i2=1,regDecompLocal(2)
do i1=1,regDecompLocal(1)
petList(k)=petMap(i1,i2,i3)
k=k+1
enddo
enddo
enddo
else
k=1
do i3=1,1
do i2=1,regDecompLocal(2)
do i1=1,regDecompLocal(1)
petList(k)=petMap(i1,i2,i3)
k=k+1
enddo
enddo
enddo
endif
!! create delayout from the petList
delayout=ESMF_DELayoutCreate(petMap=petList,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! Get rid of list
deallocate(petList)
else
!! create a default delayout
delayout=ESMF_DELayoutCreate(deCount=deCount,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
call ESMF_DELayoutGet(delayout, decount=decount, rc=localrc)
! Create DistGrid --------------------------------------------------------------
ESMF_GridCreateDistgridReg=ESMF_DistGridCreate(minIndex=minIndex, maxIndex=maxIndex, &
regDecomp=regDecompLocal, decompFlag=decompFlagLocal, delayout=delayout,&
indexflag=indexflag, &
connectionList=connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(regDecompLocal)
deallocate(decompFlagLocal)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreateDistgridReg
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "GetIndexSpaceReg"
!BOPI
! !IROUTINE: GetIndexSpaceReg - Get the index space for a regular distribution
! !INTERFACE:
subroutine GetIndexSpaceReg(minIndex, maxIndex, &
dimCount, minIndexOut, maxIndexOut, rc)
!
! !ARGUMENTS:
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: maxIndex(:)
integer, intent(inout) :: dimCount
integer, pointer :: minIndexOut(:)
integer, pointer :: maxIndexOut(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This internal method creates a single tile, regularly distributed distgrid
! (see Figure \ref{fig:GridDecomps}).
! To specify the distribution, the user passes in an array
! ({\tt regDecomp}) specifying the number of DEs to divide each
! dimension into. The array {\tt decompFlag} indicates how the division into DEs is to
! occur. The default is to divide the range as evenly as possible.
!
! The arguments are:
! \begin{description}
! \item[{[minIndex]}]
! The bottom extent of the grid array. If not given then the value defaults
! to /1,1,1,.../.
! \item[{maxIndex}]
! The upper extent of the grid array.
! \item[{minIndexOut}]
! MinIndex of range, needs to be allocated to dimCount.
! \item[{maxIndexOut}]
! MaxIndex of range, needs to be allocated to dimCount.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
integer :: localrc
integer :: i
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Compute the Grid DimCount and Derivatives ---------------------------------------------------
! dimCount
dimCount=size(maxIndex)
if ((dimCount < 2) .or. (dimCount > 3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- maxIndex size and thus Grid dimCount must be either 2 or 3 when using create shape ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (present(minIndex)) then
if (size(minIndex) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- minIndex size must equal grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! Set default for minIndex
allocate(minIndexOut(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndexOut", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(minIndex)) then
minIndexOut(:)=minIndex(:)
else
do i=1,dimCount
minIndexOut(i)=1
enddo
endif
! Set default for maxIndex
allocate(maxIndexOut(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxIndexOut", &
ESMF_CONTEXT, rcToReturn=rc)) return
maxIndexOut(:)=maxIndex(:)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine GetIndexSpaceReg
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridCreateDistgridArb"
!BOPI
! !IROUTINE: ESMF_GridCreateDistgridArg - Create a Distgrid with an arbitrary distribution
! !INTERFACE:
function ESMF_GridCreateDistgridArb(dimCount, distDimCount, isDist, distDim, minIndex, &
maxIndex, arbIndexCount, arbIndexList, connList, rc)
!
! !RETURN VALUE:
type(ESMF_Distgrid) :: ESMF_GridCreateDistgridArb
!
! !ARGUMENTS:
integer, intent(in) :: dimCount
integer, intent(in) :: distDimCount
logical, intent(in) :: isDist(:)
integer, intent(in) :: distDim(:)
integer, intent(in) :: minIndex(:)
integer, intent(in) :: maxIndex(:)
integer, intent(in) :: arbIndexCount
integer, intent(in) :: arbIndexList(:,:)
type(ESMF_DistgridConnection), intent(in), optional :: connList(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This internal method creates a single tile, arbitrarily distributed distgrid
! (see Figure \ref{fig:GridDecomps}).
! To specify the arbitrary distribution, the user passes in an 2D array
! of local indices, where the first dimension is the number of local grid cells
! specified by {\tt localArbIndexCount} and the second dimension is the number of distributed
! dimensions.
!
! {\tt distDim} specifies which grid dimensions are arbitrarily distributed. The
! size of {\tt distDim} has to agree with the size of the second dimension of
! {\tt localArbIndex}.
!
! The arguments are:
! \begin{description}
! \item[{[minIndex]}]
! Tuple to start the index ranges at. If not present, defaults
! to /1,1,1,.../.
! \item[{[maxIndex]}]
! The upper extend of the grid index ranges.
! \item[{arbIndexCount}]
! The number of grid cells in the local DE. It is okay to have 0
! grid cell in a local DE.
! \item[{[arbIndexList]}]
! This 2D array specifies the indices of the PET LOCAL grid cells. The
! dimensions should be arbIndexCount * number of Distributed grid dimensions
! where arbIndexCount is the input argument specified below
! \item[distDim]
! This array specifies which dimensions are arbitrarily distributed.
! The size of the array specifies the total distributed dimensions.
! if not specified, defaults is all dimensions will be arbitrarily
! distributed. The size has to agree with the size of the second
! dimension of {\tt localArbIndex}.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOP
type(ESMF_DistGrid) :: distgrid
integer, allocatable :: undistLBound(:), undistUBound(:)
integer, allocatable :: minDistIndex(:), maxDistIndex(:)
integer :: localrc
integer :: undistDimCount
integer :: i,j,ud
integer, allocatable :: local1DIndices(:)
integer :: ind
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! dimCounts of the undistributed part of the grid
undistDimCount=dimCount-distDimCount
! can't have all undistributed dimensions
if (distDimCount == 0) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- Need to have at least one distributed dimension", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Check local arbIndexList dimension matched with local arbIndexCount and diskDimCount
if (size(arbIndexList, 1) /= arbIndexCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- localArbIndex 1st dimension has to match with localArbIndexCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! prepare for conversion
allocate(minDistIndex(distDimCount), maxDistIndex(distDimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating local1DIndices", &
ESMF_CONTEXT, rcToReturn=rc)) return
do j = 1, distDimCount
ind = distDim(j)
minDistIndex(j) = minIndex(ind)
maxDistIndex(j) = maxIndex(ind)
enddo
allocate(local1DIndices(arbIndexCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating local1DIndices", &
ESMF_CONTEXT, rcToReturn=rc)) return
! convert local arbIndexList into local 1D sequence index list for DistGrid
if (arbIndexCount > 0) then
! loop over all entries in the local index list
do i = 1, arbIndexCount
local1DIndices(i) = ESMF_DistGridSeqIndex(minDistIndex, maxDistIndex, &
arbIndexList(i,:), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
enddo
endif
! Calc undistLBound, undistUBound for Grid -----------------------------------------------
if (undistDimCount > 0) then
allocate(undistLBound(undistDimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating undistLBound", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(undistUBound(undistDimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating undistUBound", &
ESMF_CONTEXT, rcToReturn=rc)) return
! Fill in undistLBound, undistUBound
ud=1
do i=1,dimCount
if (.not. isDist(i)) then
undistLBound(ud)=minIndex(i)
undistUBound(ud)=maxIndex(i)
ud=ud+1
endif
enddo
endif
! Create DistGrid --------------------------------------------------------------
if (undistDimCount > 0) then
ESMF_GridCreateDistgridArb=ESMF_DistGridCreate(local1DIndices, 1, undistLBound, undistUBound, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
ESMF_GridCreateDistgridArb=ESMF_DistGridCreate(local1DIndices, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Clean up memory
deallocate(minDistIndex, maxDistIndex)
deallocate(local1DIndices)
if (undistDimCount > 0) then
deallocate(undistLBound)
deallocate(undistUBound)
endif
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreateDistgridArb
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "GetIndexSpaceArb"
!BOPI
! !IROUTINE: GetIndexSpaceReg - Get the index space for a regular distribution
! !INTERFACE:
subroutine GetIndexSpaceArb(minIndex, maxIndex, &
arbIndexCount, arbIndexList, distDim, &
dimCount, distDimCount, isDistOut, distDimOut, minIndexOut, maxIndexOut, rc)
!
! !ARGUMENTS:
integer, intent(in), optional :: minIndex(:)
integer, intent(in) :: maxIndex(:)
integer, intent(in) :: arbIndexCount
integer, intent(in) :: arbIndexList(:,:)
integer, intent(in), optional :: distDim(:)
integer, intent(inout) :: dimCount
integer, intent(inout) :: distDimCount
logical, pointer :: isDistOut(:)
integer, pointer :: distDimOut(:)
integer, pointer :: minIndexOut(:)
integer, pointer :: maxIndexOut(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This internal method creates a single tile, regularly distributed distgrid
! (see Figure \ref{fig:GridDecomps}).
! To specify the distribution, the user passes in an array
! ({\tt regDecomp}) specifying the number of DEs to divide each
! dimension into. The array {\tt decompFlag} indicates how the division into DEs is to
! occur. The default is to divide the range as evenly as possible.
!
! The arguments are:
! \begin{description}
! \item[{[minIndex]}]
! The bottom extent of the grid array. If not given then the value defaults
! to /1,1,1,.../.
! \item[{maxIndex}]
! The upper extent of the grid array.
! \item[{minIndexOut}]
! MinIndex of range, needs to be allocated to dimCount.
! \item[{maxIndexOut}]
! MaxIndex of range, needs to be allocated to dimCount.
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
integer :: localrc
integer :: i
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Compute the Grid DimCount and Derivatives ---------------------------------------------------
! dimCount
dimCount=size(maxIndex)
if ((dimCount < 2) .or. (dimCount > 3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- maxIndex size and thus Grid dimCount must be either 2 or 3 when using create shape ", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Error check index size
if (present(minIndex)) then
if (size(minIndex) /= dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- minIndex size must equal grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! number of distributed dimension, distDimCount, is determined by the second dim of
! arbIndexList
distDimCount = size(arbIndexList,2)
if (distDimCount > dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- the second dim of arbIndexList must be equal or less than grid dimension", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! compute distributed dimensions and isDist list
allocate(distDimOut(distDimCount), stat=localrc)
allocate(isDistOut(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating distDimLocal or isDist", &
ESMF_CONTEXT, rcToReturn=rc)) return
isDistOut(:)=.false.
! check distribution info
if (present(distDim)) then
if (size(distDim) /= distDimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- distDim must match with the second dimension of arbIndexList", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
distDimOut(:)=distDim(:)
do i=1,distDimCount
isDistOut(distDimOut(i))=.true.
enddo
else
do i=1,distDimCount
distDimOut(i)=i
enddo
isDistOut(1:distDimCount)=.true.
endif
! Set default for minIndex
allocate(minIndexOut(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minIndexOut", &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(minIndex)) then
minIndexOut(:)=minIndex(:)
else
do i=1,dimCount
minIndexOut(i)=1
enddo
endif
! Set default for maxIndex
allocate(maxIndexOut(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxIndexOut", &
ESMF_CONTEXT, rcToReturn=rc)) return
maxIndexOut(:)=maxIndex(:)
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine GetIndexSpaceArb
! Internal subroutine to build coordDimMap and coordDimCount from coordDep
#undef ESMF_METHOD
#define ESMF_METHOD "CoordInfoFromCoordDep"
subroutine CoordInfoFromCoordDep(dimCount, coordDep1, coordDep2, coordDep3,&
coordDimCount, coordDimMap, rc)
integer, intent(in) :: dimCount
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(out), optional :: coordDimCount(:)
integer, intent(out), optional :: coordDimMap(:,:)
integer,optional :: rc
integer :: i
! Initialize return code; assume failure until success is certain
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Error checking
if ((dimCount .lt. 3) .and. present(coordDep3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- coordDep3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (present(coordDep1)) then
if ((size(coordDep1) < 1) .or. (size(coordDep1)>dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- coordDep1 size incompatible with grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(coordDep2)) then
if ((size(coordDep2) < 1) .or. (size(coordDep2)>dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- coordDep2 size incompatible with grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(coordDep3)) then
if ((size(coordDep3) < 1) .or. (size(coordDep3)>dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- coordDep3 size incompatible with grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! Set coordDimCount and coordDimMap
if (present(coordDep1)) then
coordDimCount(1)=size(coordDep1)
coordDimMap(1,:)=0
do i=1,size(coordDep1)
coordDimMap(1,i)=coordDep1(i)
enddo
else
coordDimCount(1)=dimCount
do i=1,dimCount
coordDimMap(1,i)=i
enddo
endif
if (present(coordDep2)) then
coordDimCount(2)=size(coordDep2)
coordDimMap(2,:)=0
do i=1,size(coordDep2)
coordDimMap(2,i)=coordDep2(i)
enddo
else
coordDimCount(2)=dimCount
do i=1,dimCount
coordDimMap(2,i)=i
enddo
endif
if (dimCount > 2) then
if (present(coordDep3)) then
coordDimCount(3)=size(coordDep3)
coordDimMap(3,:)=0
do i=1,size(coordDep3)
coordDimMap(3,i)=coordDep3(i)
enddo
else
coordDimCount(3)=dimCount
do i=1,dimCount
coordDimMap(3,i)=i
enddo
endif
endif
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine CoordInfoFromCoordDep
! Internal subroutine to build coordDimMap and coordDimCount from coordDep
#undef ESMF_METHOD
#define ESMF_METHOD "CoordInfoFromCoordDep"
subroutine CoordInfoFromCoordDepArb(dimCount, isDist, coordDep1, coordDep2, coordDep3,&
coordDimCount, coordDimMap, rc)
integer, intent(in) :: dimCount
logical, intent(in) :: isDist(:)
integer, intent(in), optional :: coordDep1(:)
integer, intent(in), optional :: coordDep2(:)
integer, intent(in), optional :: coordDep3(:)
integer, intent(out), optional :: coordDimCount(:)
integer, intent(out), optional :: coordDimMap(:,:)
integer,optional :: rc
integer :: i
logical :: found
! Initialize return code; assume failure until success is certain
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! Error checking
if ((dimCount .lt. 3) .and. present(coordDep3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- coordDep3 not allowed when grid is less than dimCount 3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (present(coordDep1)) then
if ((size(coordDep1) < 1) .or. (size(coordDep1)>dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- coordDep1 size incompatible with grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(coordDep2)) then
if ((size(coordDep2) < 1) .or. (size(coordDep2)>dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- coordDep2 size incompatible with grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(coordDep3)) then
if ((size(coordDep3) < 1) .or. (size(coordDep3)>dimCount)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- coordDep3 size incompatible with grid dimCount", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(coordDep1)) then
! error checking, if this dimension is arbitrary, one of the
! coordinate dimension has to be be ESMF_DIM_ARB
if (isDist(1)) then
found = .false.
do i=1,size(coordDep1)
if (coordDep1(i) == ESMF_DIM_ARB) found = .true.
enddo
if (.not. found) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- coordDep1 does not contain ESMF_DIM_ARB", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
coordDimCount(1)=size(coordDep1)
coordDimMap(1,:)=0
do i=1,size(coordDep1)
coordDimMap(1,i)=coordDep1(i)
enddo
else
coordDimCount(1)=1
! ESMF_DIM_ARB if 1 is distributed, otherwise 1
if (isDist(1)) then
coordDimMap(1,1)=ESMF_DIM_ARB
else
coordDimMap(1,1)=1
endif
endif
if (present(coordDep2)) then
! error checking, one of the dimensions has to be ESMF_DIM_ARB
! if dimension 2 is arbitrary
if (isDist(2)) then
found = .false.
do i=1,size(coordDep2)
if (coordDep2(i) == ESMF_DIM_ARB) found = .true.
enddo
if (.not. found) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- coordDep2 does not contain ESMF_DIM_ARB", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
coordDimCount(2)=size(coordDep2)
coordDimMap(2,:)=0
do i=1,size(coordDep2)
coordDimMap(2,i)=coordDep2(i)
enddo
else
coordDimCount(2)=1
! ESMF_DIM_ARB if 1 is distributed, otherwise 1
if (isDist(2)) then
coordDimMap(2,1)=ESMF_DIM_ARB
else
coordDimMap(2,1)=2
endif
endif
if (dimCount > 2) then
if (present(coordDep3)) then
! error checking, one of the dimensions has to be ESMF_DIM_ARB
! if dimension 3 is arbitrary
if (isDist(3)) then
found = .false.
do i=1,size(coordDep3)
if (coordDep3(i) == ESMF_DIM_ARB) found = .true.
enddo
if (.not. found) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, &
msg="- coordDep3 does not contain ESMF_DIM_ARB", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
coordDimCount(3)=size(coordDep3)
coordDimMap(3,:)=0
do i=1,size(coordDep3)
coordDimMap(3,i)=coordDep3(i)
enddo
else
coordDimCount(3)=1
! ESMF_DIM_ARB if 1 is distributed, otherwise 1
if (isDist(3)) then
coordDimMap(3,1)=ESMF_DIM_ARB
else
coordDimMap(3,1)=3
endif
endif
endif
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end subroutine CoordInfoFromCoordDepArb
subroutine Setup1PeriodicConn(dimCount, minIndex, maxIndex, &
polekindflag, periodicDim, poleDim, connList, periodicDimOut, rc)
integer, intent(in) :: dimCount
integer, intent(in) :: minIndex(:)
integer, intent(in) :: maxIndex(:)
type(ESMF_PoleKind_Flag), intent(in), optional :: polekindflag(2)
integer, intent(in), optional :: periodicDim
integer, intent(in), optional :: poleDim
type(ESMF_DistgridConnection), pointer :: connList(:)
integer, intent(out) :: periodicDimOut
integer, intent(out), optional :: rc
type(ESMF_PoleKind_Flag) :: polekindflagLocal(2)
integer :: periodicDimLocal
integer :: poleDimLocal
integer :: connListCount, connListPos,i
integer :: posVec(ESMF_MAXDIM)
integer :: orientVec(ESMF_MAXDIM)
integer :: widthIndex(ESMF_MAXDIM)
integer :: localrc
#if DEBUG_POLEKIND
if(present(polekindflag)) then
print *, "Setup1PeriodicConn", polekindflag(1), polekindflag(2)
endif
#endif
! Error check input
if (present(periodicDim)) then
if (periodicDim .gt. dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- periodicDim must be less than or equal to dimension of Grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (periodicDim .lt. 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- periodicDim must be at least 1", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(poleDim)) then
if (poleDim .gt. dimCount) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- poleDim must be less than or equal to dimension of Grid", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (poleDim .lt. 1) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- poleDim must be at least 1", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
! Set defaults
if (present(polekindflag)) then
polekindflagLocal(1)=polekindflag(1)
polekindflagLocal(2)=polekindflag(2)
else
polekindflagLocal(1)=ESMF_POLEKIND_MONOPOLE
polekindflagLocal(2)=ESMF_POLEKIND_MONOPOLE
endif
if (present(periodicDim)) then
periodicDimLocal=periodicDim
else
periodicDimLocal=1
endif
if (present(poleDim)) then
poleDimLocal=poleDim
else
poleDimLocal=2
endif
! ...more error checking
if (periodicDimLocal == poleDimLocal) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_INCOMP, &
msg="- periodicDim must not be equal to poleDim", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Output the localperiodicDim
periodicDimOut=periodicDimLocal
! calculate the count of elements in each index
widthIndex=0
do i=1,dimCount
widthIndex(i)=maxIndex(i)-minIndex(i)+1
enddo
! Count number of connections
connListCount=1 ! for periodic dim
if (polekindflagLocal(1) .ne. ESMF_POLEKIND_NONE) then
connListCount=connListCount+1
endif
if (polekindflagLocal(2) .ne. ESMF_POLEKIND_NONE) then
connListCount=connListCount+1
endif
! Allocate connection list
allocate(connList(connListCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating connList", &
ESMF_CONTEXT, rcToReturn=rc)) return
! Add periodic connection
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)
call ESMF_DistgridConnectionSet(connection=connList(1), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Init orient vec
do i=1,ESMF_MAXDIM
orientvec(i)=i
enddo
! Fill in pole connections
connListPos=2 ! 2 because periodic is 1
! Lower end
if (polekindflaglocal(1) .eq. ESMF_POLEKIND_MONOPOLE) then
! setup monopole connection
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)/2
posVec(poleDimLocal)=1
orientVec(poleDimLocal)=-orientVec(poleDimLocal) ! make pole dim -
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
orientationVector=orientVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Advance postion in list
connListPos=connListPos+1
else if (polekindflaglocal(1) .eq. ESMF_POLEKIND_BIPOLE) then
! setup bipole connection
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)+1
posVec(poleDimLocal)=1
orientVec(poleDimLocal)=-orientVec(poleDimLocal) ! make pole dim -
orientVec(periodicDimLocal)=-orientVec(periodicDimLocal) ! make periodic dim -
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
orientationVector=orientVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Advance postion in list
connListPos=connListPos+1
endif
! Reinit orient vec
do i=1,ESMF_MAXDIM
orientvec(i)=i
enddo
! Upper end
if (polekindflaglocal(2) .eq. ESMF_POLEKIND_MONOPOLE) then
! setup monopole connection
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)/2
posVec(poleDimLocal)=2*widthIndex(poleDimLocal)+1
orientVec(poleDimLocal)=-orientVec(poleDimLocal) ! make pole dim -
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
orientationVector=orientVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else if (polekindflaglocal(2) .eq. ESMF_POLEKIND_BIPOLE) then
! setup bipole connection
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)+1
posVec(poleDimLocal)=2*widthIndex(poleDimLocal)+1
orientVec(poleDimLocal)=-orientVec(poleDimLocal) ! make pole dim -
orientVec(periodicDimLocal)=-orientVec(periodicDimLocal) ! make periodic dim -
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
orientationVector=orientVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
end subroutine Setup1PeriodicConn
subroutine Setup2PeriodicConn(dimCount, minIndex, maxIndex, &
connList, rc)
integer, intent(in) :: dimCount
integer, intent(in) :: minIndex(:)
integer, intent(in) :: maxIndex(:)
type(ESMF_DistgridConnection), pointer :: connList(:)
integer, intent(out), optional :: rc
integer :: connListCount
integer :: posVec(ESMF_MAXDIM)
integer :: localrc
! Allocate connection list
allocate(connList(2), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating connList", &
ESMF_CONTEXT, rcToReturn=rc)) return
! Add dimension 1 periodic connection
posVec=0
posVec(1)=maxIndex(1)-minIndex(1)+1
call ESMF_DistgridConnectionSet(connection=connList(1), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Add dimension 2 periodic connection
posVec=0
posVec(2)=maxIndex(2)-minIndex(2)+1
call ESMF_DistgridConnectionSet(connection=connList(2), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
end subroutine Setup2PeriodicConn
subroutine SetupTileConn(dimCount, minIndex, maxIndex, &
connflagDim1, connflagDim2, connflagDim3, connList, rc)
integer, intent(in) :: dimCount
integer, intent(in) :: minIndex(:)
integer, intent(in) :: maxIndex(:)
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim1(:)
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim2(:)
type(ESMF_GridConn_Flag), intent(in), optional :: connflagDim3(:)
type(ESMF_DistgridConnection), pointer :: connList(:)
integer, intent(out), optional :: rc
integer :: periodicDimLocal
integer :: connListCount
integer :: connListPos
integer :: localrc
type(ESMF_GridConn_Flag) :: connflagDim1Local(2)
type(ESMF_GridConn_Flag) :: connflagDim2Local(2)
type(ESMF_GridConn_Flag) :: connflagDim3Local(2)
logical :: hasPeriod, hasPole
integer :: posVec(ESMF_MAXDIM),i
integer :: orientVec(ESMF_MAXDIM)
integer :: widthIndex(ESMF_MAXDIM)
if (present(connflagDim1)) then
if (size(connflagDim1) .ne. 2) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- connflagDim1 must have size 2", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(connflagDim2)) then
if (size(connflagDim2) .ne. 2) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- connflagDim2 must have size 2", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(connflagDim3)) then
if (size(connflagDim3) .ne. 2) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- connflagDim3 must have size 2", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
if (present(connflagDim3) .and. (dimCount <3)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- connflagDim3 should not be specified if Grid dim <3", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Set defaults
if (present(connflagDim1)) then
connflagDim1Local=connflagDim1
else
connflagDim1Local=ESMF_GRIDCONN_NONE
endif
if (present(connflagDim2)) then
connflagDim2Local=connflagDim2
else
connflagDim2Local=ESMF_GRIDCONN_NONE
endif
if (present(connflagDim3)) then
connflagDim3Local=connflagDim3
else
connflagDim3Local=ESMF_GRIDCONN_NONE
endif
! more error checking
if ((connflagDim1Local(1) .eq. ESMF_GRIDCONN_PERIODIC) .and. &
(connflagDim1Local(2) .ne. ESMF_GRIDCONN_PERIODIC)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- periodicity must be specified on both ends", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((connflagDim1Local(1) .ne. ESMF_GRIDCONN_PERIODIC) .and. &
(connflagDim1Local(2) .eq. ESMF_GRIDCONN_PERIODIC)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- periodicity must be specified on both ends", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! more error checking
if ((connflagDim2Local(1) .eq. ESMF_GRIDCONN_PERIODIC) .and. &
(connflagDim2Local(2) .ne. ESMF_GRIDCONN_PERIODIC)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- periodicity must be specified on both ends", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((connflagDim2Local(1) .ne. ESMF_GRIDCONN_PERIODIC) .and. &
(connflagDim2Local(2) .eq. ESMF_GRIDCONN_PERIODIC)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- periodicity must be specified on both ends", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! more error checking
if ((connflagDim3Local(1) .eq. ESMF_GRIDCONN_PERIODIC) .and. &
(connflagDim3Local(2) .ne. ESMF_GRIDCONN_PERIODIC)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- periodicity must be specified on both ends", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if ((connflagDim3Local(1) .ne. ESMF_GRIDCONN_PERIODIC) .and. &
(connflagDim3Local(2) .eq. ESMF_GRIDCONN_PERIODIC)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- periodicity must be specified on both ends", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! Check for periodicity
hasPeriod=.false.
if ((connflagDim1Local(1) .eq. ESMF_GRIDCONN_PERIODIC) .or. &
(connflagDim1Local(2) .eq. ESMF_GRIDCONN_PERIODIC)) then
hasPeriod=.true.
periodicDimLocal=1
endif
if ((connflagDim2Local(1) .eq. ESMF_GRIDCONN_PERIODIC) .or. &
(connflagDim2Local(2) .eq. ESMF_GRIDCONN_PERIODIC)) then
hasPeriod=.true.
periodicDimLocal=2
endif
if ((connflagDim3Local(1) .eq. ESMF_GRIDCONN_PERIODIC) .or. &
(connflagDim3Local(2) .eq. ESMF_GRIDCONN_PERIODIC)) then
hasPeriod=.true.
periodicDimLocal=3
endif
! Check for poles
hasPole=.false.
if ((connflagDim1Local(1) .eq. ESMF_GRIDCONN_POLE) .or. &
(connflagDim1Local(1) .eq. ESMF_GRIDCONN_BIPOLE) .or. &
(connflagDim1Local(2) .eq. ESMF_GRIDCONN_POLE) .or. &
(connflagDim1Local(2) .eq. ESMF_GRIDCONN_BIPOLE)) then
hasPole=.true.
endif
if ((connflagDim2Local(1) .eq. ESMF_GRIDCONN_POLE) .or. &
(connflagDim2Local(1) .eq. ESMF_GRIDCONN_BIPOLE) .or. &
(connflagDim2Local(2) .eq. ESMF_GRIDCONN_POLE) .or. &
(connflagDim2Local(2) .eq. ESMF_GRIDCONN_BIPOLE)) then
hasPole=.true.
endif
if ((connflagDim3Local(1) .eq. ESMF_GRIDCONN_POLE) .or. &
(connflagDim3Local(1) .eq. ESMF_GRIDCONN_BIPOLE) .or. &
(connflagDim3Local(2) .eq. ESMF_GRIDCONN_POLE) .or. &
(connflagDim3Local(2) .eq. ESMF_GRIDCONN_BIPOLE)) then
hasPole=.true.
endif
! Error check
if (hasPole .and. .not. hasPeriod) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_BAD, &
msg="- if a grid has a pole, it must be periodic", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! calculate the count of elements in each index
widthIndex=0
do i=1,dimCount
widthIndex(i)=maxIndex(i)-minIndex(i)+1
enddo
! Count connections
connListCount=0
!!!!!!!!! Connections for 1 !!!!!!!!!!!!!!!!!!!!!1
if (connflagDim1Local(1) .eq. ESMF_GRIDCONN_PERIODIC) then
connListCount=connListCount+1
else if (connflagDim1Local(1) .eq. ESMF_GRIDCONN_POLE) then
connListCount=connListCount+1
else if (connflagDim1Local(1) .eq. ESMF_GRIDCONN_BIPOLE) then
connListCount=connListCount+1
endif
if (connflagDim1Local(2) .eq. ESMF_GRIDCONN_POLE) then
connListCount=connListCount+1
else if (connflagDim1Local(2) .eq. ESMF_GRIDCONN_BIPOLE) then
connListCount=connListCount+1
endif
!!!!!!!!! Connections for 2 !!!!!!!!!!!!!!!!!!!!!1
if (connflagDim2Local(1) .eq. ESMF_GRIDCONN_PERIODIC) then
connListCount=connListCount+1
else if (connflagDim2Local(1) .eq. ESMF_GRIDCONN_POLE) then
connListCount=connListCount+1
else if (connflagDim2Local(1) .eq. ESMF_GRIDCONN_BIPOLE) then
connListCount=connListCount+1
endif
if (connflagDim2Local(2) .eq. ESMF_GRIDCONN_POLE) then
connListCount=connListCount+1
else if (connflagDim2Local(2) .eq. ESMF_GRIDCONN_BIPOLE) then
connListCount=connListCount+1
endif
!!!!!!!!! Connections for 3 !!!!!!!!!!!!!!!!!!!!!1
if (connflagDim3Local(1) .eq. ESMF_GRIDCONN_PERIODIC) then
connListCount=connListCount+1
else if (connflagDim3Local(1) .eq. ESMF_GRIDCONN_POLE) then
connListCount=connListCount+1
else if (connflagDim3Local(1) .eq. ESMF_GRIDCONN_BIPOLE) then
connListCount=connListCount+1
endif
if (connflagDim3Local(2) .eq. ESMF_GRIDCONN_POLE) then
connListCount=connListCount+1
else if (connflagDim3Local(2) .eq. ESMF_GRIDCONN_BIPOLE) then
connListCount=connListCount+1
endif
! Allocate connection list to maximum number possible
allocate(connList(connListCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating connList", &
ESMF_CONTEXT, rcToReturn=rc)) return
! init connectionCount
connListPos=1
!!!!!!!!! Connections for 1 !!!!!!!!!!!!!!!!!!!!!1
! Init orient vec
do i=1,ESMF_MAXDIM
orientvec(i)=i
enddo
if (connflagDim1Local(1) .eq. ESMF_GRIDCONN_PERIODIC) then
posVec=0
posVec(1)=widthIndex(1)
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
connListPos=connListPos+1
else if (connflagDim1Local(1) .eq. ESMF_GRIDCONN_POLE) then
! do pole connection
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)/2
posVec(1)=1
orientVec(1)=-orientVec(1) ! make pole dim -
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
orientationVector=orientVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
connListPos=connListPos+1
else if (connflagDim1Local(1) .eq. ESMF_GRIDCONN_BIPOLE) then
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)+1
posVec(1)=1
orientVec(1)=-orientVec(1) ! make pole dim -
orientVec(periodicDimLocal)=-orientVec(periodicDimLocal) ! make periodic dim -
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
orientationVector=orientVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
connListPos=connListPos+1
endif
! Init orient vec
do i=1,ESMF_MAXDIM
orientvec(i)=i
enddo
if (connflagDim1Local(2) .eq. ESMF_GRIDCONN_POLE) then
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)/2
posVec(1)=2*widthIndex(1)+1
orientVec(1)=-orientVec(1) ! make pole dim -
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
orientationVector=orientVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
connListPos=connListPos+1
else if (connflagDim1Local(2) .eq. ESMF_GRIDCONN_BIPOLE) then
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)+1
posVec(1)=2*widthIndex(1)+1
orientVec(1)=-orientVec(1) ! make pole dim -
orientVec(periodicDimLocal)=-orientVec(periodicDimLocal) ! make periodic dim -
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
orientationVector=orientVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
connListPos=connListPos+1
endif
!!!!!!!!! Connections for 2 !!!!!!!!!!!!!!!!!!!!!1
! Init orient vec
do i=1,ESMF_MAXDIM
orientvec(i)=i
enddo
if (connflagDim2Local(1) .eq. ESMF_GRIDCONN_PERIODIC) then
posVec=0
posVec(2)=widthIndex(2)
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
connListPos=connListPos+1
else if (connflagDim2Local(1) .eq. ESMF_GRIDCONN_POLE) then
! do pole connection
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)/2
posVec(2)=1
orientVec(2)=-orientVec(2) ! make pole dim -
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
orientationVector=orientVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
connListPos=connListPos+1
else if (connflagDim2Local(1) .eq. ESMF_GRIDCONN_BIPOLE) then
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)+1
posVec(2)=1
orientVec(2)=-orientVec(2) ! make pole dim -
orientVec(periodicDimLocal)=-orientVec(periodicDimLocal) ! make periodic dim -
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
orientationVector=orientVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
connListPos=connListPos+1
endif
! Init orient vec
do i=1,ESMF_MAXDIM
orientvec(i)=i
enddo
if (connflagDim2Local(2) .eq. ESMF_GRIDCONN_POLE) then
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)/2
posVec(2)=2*widthIndex(2)+1
orientVec(2)=-orientVec(2) ! make pole dim -
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
orientationVector=orientVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
connListPos=connListPos+1
else if (connflagDim2Local(2) .eq. ESMF_GRIDCONN_BIPOLE) then
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)+1
posVec(2)=2*widthIndex(2)+1
orientVec(2)=-orientVec(2) ! make pole dim -
orientVec(periodicDimLocal)=-orientVec(periodicDimLocal) ! make periodic dim -
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
orientationVector=orientVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
connListPos=connListPos+1
endif
!!!!!!!!! Connections for 3 !!!!!!!!!!!!!!!!!!!!!1
! Init orient vec
do i=1,ESMF_MAXDIM
orientvec(i)=i
enddo
if (connflagDim3Local(1) .eq. ESMF_GRIDCONN_PERIODIC) then
posVec=0
posVec(3)=widthIndex(3)
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
connListPos=connListPos+1
else if (connflagDim3Local(1) .eq. ESMF_GRIDCONN_POLE) then
! do pole connection
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)/2
posVec(3)=1
orientVec(3)=-orientVec(3) ! make pole dim -
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
orientationVector=orientVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
connListPos=connListPos+1
else if (connflagDim3Local(1) .eq. ESMF_GRIDCONN_BIPOLE) then
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)+1
posVec(3)=1
orientVec(3)=-orientVec(3) ! make pole dim -
orientVec(periodicDimLocal)=-orientVec(periodicDimLocal) ! make periodic dim -
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
orientationVector=orientVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
connListPos=connListPos+1
endif
! Init orient vec
do i=1,ESMF_MAXDIM
orientvec(i)=i
enddo
if (connflagDim3Local(2) .eq. ESMF_GRIDCONN_POLE) then
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)/2
posVec(3)=2*widthIndex(3)+1
orientVec(3)=-orientVec(3) ! make pole dim -
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
orientationVector=orientVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
connListPos=connListPos+1
else if (connflagDim3Local(2) .eq. ESMF_GRIDCONN_BIPOLE) then
posVec=0
posVec(periodicDimLocal)=widthIndex(periodicDimLocal)+1
posVec(3)=2*widthIndex(3)+1
orientVec(3)=-orientVec(3) ! make pole dim -
orientVec(periodicDimLocal)=-orientVec(periodicDimLocal) ! make periodic dim -
call ESMF_DistgridConnectionSet(connection=connList(connListPos), &
tileIndexA=1,tileIndexB=1, &
positionVector=posVec(1:dimCount), &
orientationVector=orientVec(1:dimCount), &
rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
connListPos=connListPos+1
endif
end subroutine SetupTileConn
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_PoleTypeEqual"
!BOPI
! !IROUTINE: ESMF_PoleTypeEqual - Equality of PoleType statuses
!
! !INTERFACE:
impure elemental function ESMF_PoleTypeEqual(PoleType1, PoleType2)
! !RETURN VALUE:
logical :: ESMF_PoleTypeEqual
! !ARGUMENTS:
type (ESMF_PoleKind_Flag), intent(in) :: &
PoleType1, &! Two igrid statuses to compare for
PoleType2 ! equality
! !DESCRIPTION:
! This routine compares two ESMF PoleType statuses to see if
! they are equivalent.
!
! The arguments are:
! \begin{description}
! \item[PoleType1, PoleType2]
! Two igrid statuses to compare for equality
! \end{description}
!
!EOPI
ESMF_PoleTypeEqual = (PoleType1%polekind == &
PoleType2%polekind)
end function ESMF_PoleTypeEqual
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_PoleTypeNotEqual"
!BOPI
! !IROUTINE: ESMF_PoleTypeNotEqual - Non-equality of PoleType statuses
!
! !INTERFACE:
impure elemental function ESMF_PoleTypeNotEqual(PoleType1, PoleType2)
! !RETURN VALUE:
logical :: ESMF_PoleTypeNotEqual
! !ARGUMENTS:
type (ESMF_PoleKind_Flag), intent(in) :: &
PoleType1, &! Two PoleType Statuses to compare for
PoleType2 ! inequality
! !DESCRIPTION:
! This routine compares two ESMF PoleType statuses to see if
! they are unequal.
!
! The arguments are:
! \begin{description}
! \item[PoleType1, PoleType2]
! Two statuses of PoleTypes to compare for inequality
! \end{description}
!
!EOPI
ESMF_PoleTypeNotEqual = (PoleType1%polekind /= &
PoleType2%polekind)
end function ESMF_PoleTypeNotEqual
#undef ESMF_METHOD
!------------------------------------------------------------------------------
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_GridItemAssignment"
!BOPI
! !IROUTINE: ESMF_GridItemAssignment - Assign string to ESMF_GridItem_Flag
!
! !INTERFACE:
subroutine ESMF_GridItemAssignment(gival, string)
! !ARGUMENTS:
type(ESMF_GridItem_Flag), intent(out) :: gival
character(len=*), intent(in) :: string
! !DESCRIPTION:
! This routine assigns a string to an ESMF_GridItem_Flag
!
! The arguments are:
! \begin{description}
! \item[string]
! String value representing an ESMF_GridItem_Flag
! \end{description}
!
!EOPI
if (string == "ESMF_GRIDITEM_INVALID") then
gival = ESMF_GRIDITEM_INVALID
else if (string == "ESMF_GRIDITEM_UNINIT") then
gival = ESMF_GRIDITEM_UNINIT
else if (string == "ESMF_GRIDITEM_MASK") then
gival = ESMF_GRIDITEM_MASK
else if (string == "ESMF_GRIDITEM_AREA") then
gival = ESMF_GRIDITEM_AREA
endif
end subroutine ESMF_GridItemAssignment
#undef ESMF_METHOD
#define ESMF_METHOD "ESMF_OutputScripGridFile"
!BOPI
! !ROUTINE: ESMF_OUtputScripGridFile
! Write out a SCRIP Grid File from a ESMF_Grid Object, it will be useful
! to write out a ESMF_Mesh object in the future
! A quick hidden subroutine for Fei
subroutine ESMF_OutputScripGridFile(filename, grid, rc)
character(len=*), intent(in) :: filename
type(ESMF_GRID), intent(in) :: grid
integer :: rc
integer :: ncid, dimid, varid, nodedimid
integer :: localrc, ncStatus
integer :: varsize
integer :: ndims, dims(ESMF_MAXDIM)
integer :: PetNo, PetCnt
type(ESMF_STAGGERLOC), allocatable :: Staggers(:)
integer :: staggercnt, decount, xdim, ydim
integer :: londim, londim1, latdim, latdim1, gridid
integer :: rankid, fourid, varid1, varid2, varid3, varid4
integer :: maskid, areaid
integer :: elmtsize, count, i, j, n, nextj
integer, pointer :: minindex(:), maxindex(:)
logical :: xperiod, yperiod
type(ESMF_VM) :: vm
type(ESMF_Grid) :: grid1
type(ESMF_DistGrid) :: distgrid
type(ESMF_Array) :: array
type(ESMF_Array) :: lonarray, latarray
type(ESMF_CoordSys_Flag) :: coordsys
real(ESMF_KIND_R8), pointer::lonArray1d(:), latArray1d(:)
real(ESMF_KIND_R8), pointer::lonArray2d(:,:), latArray2d(:,:)
real(ESMF_KIND_R8), pointer::scripArray(:)
real(ESMF_KIND_R8), pointer::scripArray2(:,:)
integer(ESMF_KIND_I4), pointer :: fptrMask(:,:), scripArrayMask(:)
logical :: hasmask, hasarea
character (len=256) :: errmsg, units
#ifdef ESMF_NETCDF
call ESMF_VMGetCurrent(vm, rc=rc)
if (rc /= ESMF_SUCCESS) return
! set up local pet info
call ESMF_VMGet(vm, localPet=PetNo, petCount=PetCnt, rc=rc)
if (rc /= ESMF_SUCCESS) return
! find out the grid size and other global information
call ESMF_GridGet(grid, dimCount=ndims, localDECount=decount, &
coordDimCount=dims, coordSys=coordsys, distgrid=distgrid, &
staggerlocCount=staggercnt, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get list and number of active staggers
allocate(Staggers(staggercnt))
call c_ESMC_gridgetactivestaggers(grid%this, &
staggercnt, Staggers, localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
deallocate(Staggers)
if (ndims /= 2) then
call ESMF_LogSetError(rcToCheck=ESMF_FAILURE, &
msg="- Grid dimension has to be 2 to write out to a SCRIP file", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (decount > 1) then
call ESMF_LogSetError(rcToCheck=ESMF_FAILURE, &
msg="- Only one localDE per PET is allowed to write a grid into a SCRIP file", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
allocate(minindex(ndims), maxindex(ndims))
call ESMF_GridGet(grid, tile=1, staggerloc=ESMF_STAGGERLOC_CENTER, minIndex=minindex, &
maxIndex=maxindex,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! find the size of the grid
londim = maxindex(1)-minindex(1)+1
latdim = maxindex(2)-minindex(2)+1
elmtsize=londim * latdim
if (coordsys == ESMF_COORDSYS_SPH_DEG) then
units="degrees"
elseif (coordsys == ESMF_COORDSYS_SPH_RAD) then
units="radians"
else
!ESMF_COORDSYS_CART not supported -- errors
call ESMF_LogSetError(rcToCheck=ESMF_FAILURE, &
msg="- ESMF_ScripOuputGridFile does not support ESMF_COORDSYS_CART coordinates", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
if (PetNo==0) then
! Create the GRID file and define dimensions and variables
ncStatus=nf90_create(filename, NF90_CLOBBER, ncid)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
trim(filename),&
rc)) return
ncStatus=nf90_def_dim(ncid,"grid_size",elmtsize, nodedimid)
errmsg = "defining dimension grid_size in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
ncStatus=nf90_def_dim(ncid,"grid_rank", 2, rankid)
errmsg = "defining dimension grid_rank in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
if (staggercnt > 1) then
ncStatus=nf90_def_dim(ncid,"grid_corners", 4, fourid)
errmsg = "defining dimension grid_corner in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
endif
ncStatus=nf90_def_var(ncid,"grid_dims",NF90_INT, (/rankid/), gridid)
errmsg = "defining variable grid_dims in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
ncStatus=nf90_def_var(ncid,"grid_center_lon",NF90_DOUBLE, (/nodedimid/), varid1)
errmsg = "defining variable grid_center_lon in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
! add units attribute based on the COORDSYS
ncStatus=nf90_put_att(ncid,varid1,"units",trim(units))
errmsg = "Adding attribute units for grid_center_lon in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
ncStatus=nf90_def_var(ncid,"grid_center_lat",NF90_DOUBLE, (/nodedimid/), varid2)
errmsg = "defining variable grid_center_lat in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
ncStatus=nf90_put_att(ncid,varid2,"units",trim(units))
errmsg = "Adding attribute units for grid_center_lat in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
if (staggercnt > 1) then
ncStatus=nf90_def_var(ncid,"grid_corner_lon",NF90_DOUBLE, (/fourid,nodedimid/), varid3)
errmsg = "defining variable grid_corner_lon in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
! add units attribute based on the COORDSYS
ncStatus=nf90_put_att(ncid,varid3,"units",trim(units))
errmsg = "Adding attribute units for grid_corner_lon in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
ncStatus=nf90_def_var(ncid,"grid_corner_lat",NF90_DOUBLE, (/fourid, nodedimid/), varid4)
errmsg = "defining variable grid_corner_lat in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
ncStatus=nf90_put_att(ncid,varid4,"units",trim(units))
errmsg = "Adding attribute units for grid_corner_lat in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
endif
hasmask = .false.
hasarea = .false.
! If the grid has mask and area, output them too
call ESMF_GridGetItem(grid, ESMF_GRIDITEM_MASK, staggerloc=ESMF_STAGGERLOC_CENTER, &
array=array, rc=localrc)
if (localrc == ESMF_SUCCESS) then
ncStatus=nf90_def_var(ncid, "grid_imask", NF90_INT, (/nodedimid/), maskid)
errmsg = "defining variable grid_imask in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
hasmask = .true.
endif
call ESMF_GridGetItem(grid, ESMF_GRIDITEM_AREA, staggerloc=ESMF_STAGGERLOC_CENTER, &
array=array, rc=localrc)
if (localrc == ESMF_SUCCESS) then
ncStatus=nf90_def_var(ncid, "grid_area", NF90_DOUBLE, (/nodedimid/), areaid)
errmsg = "defining variable grid_area in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
hasarea = .true.
endif
ncStatus=nf90_enddef(ncid)
errmsg = "nf90_enddef in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
! write the grid_dims value
ncStatus = nf90_put_var(ncid,gridid,(/londim, latdim/))
errmsg = "writing grid_dims in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
endif
call ESMF_VMBarrier(vm)
! Create a grid at Pet 0 with the same size as the source grid
distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/londim, latdim/), &
regDecomp=(/1,1/),rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
grid1 = ESMF_GridCreate(grid, distgrid, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Get the coordinate data from grid1 at PET 0 to output to the file
if (PetNo == 0) then
call ESMF_GridGetCoord(grid1, 1, staggerloc=ESMF_STAGGERLOC_CENTER, &
array=lonarray, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGetCoord(grid1, 2, staggerloc=ESMF_STAGGERLOC_CENTER, &
array=latarray, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Extra the data from array and create 2D lat and lon array to write
! to the file
if (dims(1)==1) then
call ESMF_ArrayGet(lonarray,farrayPtr=lonArray1d, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayGet(latarray,farrayPtr=latArray1d, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(scripArray(elmtsize))
do i=1,elmtsize,londim
scripArray(i:i+londim)=lonArray1d
enddo
ncStatus=nf90_put_var(ncid, varid1, scripArray)
errmsg = "Writing variable grid_corner_lon in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
j=1
do i=1,latdim
scripArray(j:j+londim)=latArray1d(i)
j=j+londim
enddo
ncStatus=nf90_put_var(ncid, varid2, scripArray)
errmsg = "Writing variable grid_corner_lat in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
deallocate(scripArray)
else
call ESMF_ArrayGet(lonarray,farrayPtr=lonArray2d, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayGet(latarray,farrayPtr=latArray2d, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(scripArray(elmtsize))
scripArray=reshape(lonArray2d,(/elmtsize/))
ncStatus=nf90_put_var(ncid, varid1, scripArray)
errmsg = "Writing variable grid_corner_lon in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
scripArray=reshape(latArray2d,(/elmtsize/))
ncStatus=nf90_put_var(ncid, varid2, scripArray)
errmsg = "Writing variable grid_corner_lat in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
deallocate(scripArray)
endif
!call ESMF_ArrayDestroy(lonArray)
!call ESMF_ArrayDestroy(latArray)
! Get corner stagger if exist
if (staggercnt > 1) then
call ESMF_GridGetCoord(grid1, 1, staggerloc=ESMF_STAGGERLOC_CORNER, &
array=lonarray, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGetCoord(grid1, 2, staggerloc=ESMF_STAGGERLOC_CORNER, &
array=latarray, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Find the corner stagger array dimension, it may have one periodic dimension
call ESMF_GridGet(grid, tile=1, staggerloc=ESMF_STAGGERLOC_CORNER,&
minIndex=minIndex, maxIndex=maxIndex, rc=localrc)
londim1 = maxIndex(1)-minIndex(1)+1
latdim1 = maxIndex(2)-minIndex(2)+1
xperiod = .false.
yperiod = .false.
if (londim1 == londim) then
!This is periodic dimension, need to wrap around
xperiod = .true.
endif
if (latdim1 == latdim) then
!This is periodic dimension, need to wrap around
yperiod = .true.
endif
deallocate(minindex, maxindex)
!print *, 'Corner stagger dimension ', londim1, latdim1
! Extract the data from array and create 2D lat and lon array to write
! to the file
if (dims(1)==1) then
call ESMF_ArrayGet(lonarray,farrayPtr=lonArray1d, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayGet(latarray,farrayPtr=latArray1d, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(scripArray2(4,elmtsize))
count = 1
do j=1,latdim
do i=1,londim-1
scripArray2(1,count)=lonArray1d(i)
scripArray2(2,count)=lonArray1d(i+1)
scripArray2(3,count)=lonArray1d(i+1)
scripArray2(4,count)=lonArray1d(i)
count = count+1
enddo
if (xperiod) then
scripArray2(1,count)=lonArray1d(i)
scripArray2(2,count)=lonArray1d(1)
scripArray2(3,count)=lonArray1d(1)
scripArray2(4,count)=lonArray1d(i)
count = count+1
else
scripArray2(1,count)=lonArray1d(i)
scripArray2(2,count)=lonArray1d(i+1)
scripArray2(3,count)=lonArray1d(i+1)
scripArray2(4,count)=lonArray1d(i)
count = count+1
endif
enddo
ncStatus=nf90_put_var(ncid, varid3, scripArray2)
errmsg = "Writing variable grid_center_lon in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
count = 1
do j=1,latdim-1
do i=1,londim
scripArray2(1,count)=latArray1d(j)
scripArray2(2,count)=latArray1d(j)
scripArray2(3,count)=latArray1d(j+1)
scripArray2(4,count)=latArray1d(j+1)
count = count+1
enddo
enddo
if (yperiod) then
do i=1,londim
scripArray2(1,count)=latArray1d(j)
scripArray2(2,count)=latArray1d(j)
scripArray2(3,count)=latArray1d(1)
scripArray2(4,count)=latArray1d(1)
count = count+1
enddo
else
do i=1,londim
scripArray2(1,count)=latArray1d(j)
scripArray2(2,count)=latArray1d(j)
scripArray2(3,count)=latArray1d(j+1)
scripArray2(4,count)=latArray1d(j+1)
count = count+1
enddo
endif
ncStatus=nf90_put_var(ncid, varid4, scripArray2)
errmsg = "Writing variable grid_center_lat in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
deallocate(scripArray2)
else !dims==2
call ESMF_ArrayGet(lonarray,farrayPtr=lonArray2d, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_ArrayGet(latarray,farrayPtr=latArray2d, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(scripArray2(4,elmtsize))
count = 1
do j=1,latdim
if (j==latdim .and. yperiod) then
nextj=1
else
nextj=j+1
endif
do i=1,londim-1
scripArray2(1,count)=lonArray2d(i,j)
scripArray2(2,count)=lonArray2d(i+1,j)
scripArray2(3,count)=lonArray2d(i+1,nextj)
scripArray2(4,count)=lonArray2d(i,nextj)
count = count+1
enddo
if (xperiod) then
scripArray2(1,count)=lonArray2d(i,j)
scripArray2(2,count)=lonArray2d(1,j)
scripArray2(3,count)=lonArray2d(1,nextj)
scripArray2(4,count)=lonArray2d(i,nextj)
count = count+1
else
scripArray2(1,count)=lonArray2d(i,j)
scripArray2(2,count)=lonArray2d(i+1,j)
scripArray2(3,count)=lonArray2d(i+1,nextj)
scripArray2(4,count)=lonArray2d(i,nextj)
count = count+1
endif
enddo
ncStatus=nf90_put_var(ncid, varid3, scripArray2)
errmsg = "Writing variable grid_center_lon in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
count = 1
do j=1,latdim
if (j==latdim .and. yperiod) then
nextj=1
else
nextj=j+1
endif
do i=1,londim-1
scripArray2(1,count)=latArray2d(i,j)
scripArray2(2,count)=latArray2d(i+1,j)
scripArray2(3,count)=latArray2d(i+1,nextj)
scripArray2(4,count)=latArray2d(i,nextj)
count = count+1
enddo
if (xperiod) then
scripArray2(1,count)=latArray2d(i,j)
scripArray2(2,count)=latArray2d(1,j)
scripArray2(3,count)=latArray2d(1,nextj)
scripArray2(4,count)=latArray2d(i,nextj)
count = count+1
else
scripArray2(1,count)=latArray2d(i,j)
scripArray2(2,count)=latArray2d(i+1,j)
scripArray2(3,count)=latArray2d(i+1,nextj)
scripArray2(4,count)=latArray2d(i,nextj)
count = count+1
endif
enddo
ncStatus=nf90_put_var(ncid, varid4, scripArray2)
errmsg = "Writing variable grid_center_lat in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
deallocate(scripArray2)
endif !staggercnt > 1
if (hasmask) then
call ESMF_GridGetItem(grid1, ESMF_GRIDITEM_MASK, farrayPtr=fptrMask, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(scripArrayMask(elmtsize))
scripArrayMask=reshape(fptrMask,(/elmtsize/))
ncStatus=nf90_put_var(ncid, maskid, scripArrayMask)
errmsg = "Writing variable grid_imask in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
deallocate(scripArrayMask)
endif
if (hasarea) then
call ESMF_GridGetItem(grid1, ESMF_GRIDITEM_AREA, farrayPtr=scripArray2, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(scripArray(elmtsize))
scripArray=reshape(fptrMask,(/elmtsize/))
ncStatus=nf90_put_var(ncid, areaid, scripArray)
errmsg = "Writing variable grid_area in "//trim(filename)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
errmsg,&
rc)) return
deallocate(scripArray)
endif
endif !PetNo==0
!call ESMF_ArrayDestroy(lonArray)
!call ESMF_ArrayDestroy(latArray)
ncStatus = nf90_close(ncid)
if (CDFCheckError (ncStatus, &
ESMF_METHOD, &
ESMF_SRCLINE,&
trim(filename),&
rc)) return
endif !PET==0
return
#else
call ESMF_LogSetError(rcToCheck=ESMF_RC_LIB_NOT_PRESENT, &
msg="- ESMF_NETCDF not defined when lib was compiled", &
ESMF_CONTEXT, rcToReturn=rc)
return
#endif
end subroutine ESMF_OutputScripGridFile
#if 0
!-----------------------------------------------------------------------
!
! check CDF file error code
!
#undef ESMF_METHOD
#define ESMF_METHOD "CDFCheckError"
function CDFCheckError (ncStatus, module, fileName, lineNo, errmsg, rc)
logical :: CDFCheckError
integer, intent(in) :: ncStatus
character(len=*), intent(in) :: module
character(len=*), intent(in) :: fileName
integer, intent(in) :: lineNo
character(len=*), intent(in) :: errmsg
integer, intent(out),optional :: rc
integer, parameter :: nf90_noerror = 0
CDFCheckError = .FALSE.
#ifdef ESMF_NETCDF
if ( ncStatus .ne. nf90_noerror) then
call ESMF_LogWrite (msg="netCDF Status Return Error", logmsgFlag=ESMF_LOGMSG_ERROR, &
line=lineNo, file=fileName, method=module)
print '("NetCDF Error: ", A, " : ", A)', &
trim(errmsg),trim(nf90_strerror(ncStatus))
call ESMF_LogFlush()
if (present(rc)) rc = ESMF_FAILURE
CDFCheckError = .TRUE.
else
if (present(rc)) rc = ESMF_SUCCESS
return
end if
#else
call ESMF_LogSetError(rcToCheck=ESMF_RC_LIB_NOT_PRESENT, &
msg="- ESMF_NETCDF not defined when lib was compiled", &
ESMF_CONTEXT, rcToReturn=rc)
return
#endif
end function CDFCheckError
#undef ESMF_METHOD
#endif
end module ESMF_GridMod