! $Id$ ! ! Earth System Modeling Framework ! Copyright (c) 2002-2023, 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, 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 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. See section ! \ref{sec:usage:cubedspherewttransform} for details. ! \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 integer :: s logical :: docenter, docorner !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 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) ! 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) elseif (docorner) then call ESMF_UtilCreateCSCoordsPar(tileSize, lonEdge=lonCornerPtrR8, & latEdge=latCornerPtrR8, start=start, count=count, tile=tile, & schmidtTransform=transformArgs) else call ESMF_UtilCreateCSCoordsPar(tileSize, & start=start, count=count, & tile=tile, lonCenter=lonPtrR8, latCenter=latPtrR8, & schmidtTransform=transformArgs) 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, 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 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[{[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 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 !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 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) ! 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) elseif (docorner) then call ESMF_UtilCreateCSCoordsPar(tileSize, lonEdge=lonCornerPtrR8, & latEdge=latCornerPtrR8, start=start, count=count, tile=tile, & schmidtTransform=transformArgs) else call ESMF_UtilCreateCSCoordsPar(tileSize, & start=start, count=count, & tile=tile, lonCenter=lonPtrR8, latCenter=latPtrR8, & schmidtTransform=transformArgs) 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