! $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_Mesh.F90" !============================================================================== ! ! ESMF Mesh Module module ESMF_MeshMod ! !============================================================================== ! ! This file contains the F90 wrapper code for the C++ implementation of ! the Mesh class. ! !------------------------------------------------------------------------------ ! INCLUDES #include "ESMF.h" !============================================================================== !------------------------------------------------------------------------------ ! The following line turns the CVS identifier string into a printable variable. ! character(*), parameter, private :: version = & ! '$Id$' !============================================================================== !BOPI ! !MODULE: ESMF_MeshMod ! ! F90 API wrapper of C++ implementation of Mesh ! !------------------------------------------------------------------------------ ! !USES: use iso_c_binding use ESMF_UtilTypesMod ! ESMF utility types use ESMF_InitMacrosMod ! ESMF initializer macros use ESMF_BaseMod ! ESMF base class use ESMF_LogErrMod ! ESMF error handling use ESMF_IOUtilMod use ESMF_VMMod use ESMF_DELayoutMod use ESMF_DistGridMod use ESMF_RHandleMod use ESMF_F90InterfaceMod ! ESMF F90-C++ interface helper use ESMF_IOScripMod use ESMF_IOUGridMod use ESMF_ArrayMod use ESMF_UtilCubedSphereMod use ESMF_GridMod implicit none !------------------------------------------------------------------------------ ! !PRIVATE TYPES: private !------------------------------------------------------------------------------ ! ! ESMF_MeshStatus_Flag ! !------------------------------------------------------------------------------ type ESMF_MeshStatus_Flag #ifndef ESMF_NO_SEQUENCE sequence #endif ! private integer :: meshstatus end type type(ESMF_MeshStatus_Flag), parameter :: & ESMF_MESHSTATUS_UNINIT=ESMF_MeshStatus_Flag(0), & ESMF_MESHSTATUS_EMPTY=ESMF_MeshStatus_Flag(1), & ESMF_MESHSTATUS_STRUCTCREATED=ESMF_MeshStatus_Flag(2), & ESMF_MESHSTATUS_NODESADDED=ESMF_MeshStatus_Flag(3), & ESMF_MESHSTATUS_COMPLETE=ESMF_MeshStatus_Flag(4) !------------------------------------------------------------------------------ ! ! ESMF_Mesh ! !------------------------------------------------------------------------------ ! F90 class type to hold pointer to C++ object type ESMF_Mesh #ifndef ESMF_NO_SEQUENCE sequence #endif type(ESMF_Pointer) :: this ESMF_INIT_DECLARE end type type ESMF_MeshElement #ifndef ESMF_NO_SEQUENCE sequence #endif ! private integer :: meshelement end type !!!! !! Use integers instead of type, to be compatible with reading in from VTK and other files !! type(ESMF_MeshElement), parameter :: & !! ESMF_MESHELEMTYPE_QUAD = ESMF_MeshElement(0), & !! ESMF_MESHELEMTYPE_TRI = ESMF_MeshElement(1), & !! ESMF_MESHELEMTYPE_HEX = ESMF_MeshElement(2), & !! ESMF_MESHELEMTYPE_TET = ESMF_MeshElement(3) !!!! integer, parameter :: & ESMF_MESHELEMTYPE_TRI = 3, & ! Triangle ESMF_MESHELEMTYPE_QUAD = 4, & ! Quadralateral ESMF_MESHELEMTYPE_TETRA = 10, & ! Tetrahedron ESMF_MESHELEMTYPE_HEX = 12 ! Hexahedron type ESMF_MeshLoc #ifndef ESMF_NO_SEQUENCE sequence #endif ! private integer :: meshloc end type type(ESMF_MeshLoc), parameter :: & ESMF_MESHLOC_NODE = ESMF_MeshLoc(0), & ESMF_MESHLOC_ELEMENT = ESMF_MeshLoc(1), & ESMF_MESHLOC_NONE = ESMF_MeshLoc(2) !------------------------------------------------------------------------------ ! ! ESMF_Mesh ! !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ ! !PUBLIC TYPES: public ESMF_Mesh public ESMF_MESHELEMTYPE_QUAD, ESMF_MESHELEMTYPE_TRI, & ESMF_MESHELEMTYPE_HEX, ESMF_MESHELEMTYPE_TETRA public ESMF_MeshLoc public ESMF_MESHLOC_NODE, ESMF_MESHLOC_ELEMENT public ESMF_MeshStatus_Flag public ESMF_MESHSTATUS_UNINIT, & ESMF_MESHSTATUS_STRUCTCREATED, & ESMF_MESHSTATUS_NODESADDED, & ESMF_MESHSTATUS_EMPTY, & ESMF_MESHSTATUS_COMPLETE !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ ! ! !PUBLIC MEMBER FUNCTIONS: ! - ESMF-public methods: public assignment(=) public operator(==) public operator(/=) public ESMF_MeshCreate public ESMF_MeshWrite public ESMF_MeshWriteVTK public ESMF_MeshAddNodes public ESMF_MeshAddElements public ESMF_MeshDestroy public ESMF_MeshFreeMemory public ESMF_MeshGetInit public ESMF_MeshGet public ESMF_MeshIsCreated public ESMF_MeshMatch public ESMF_MeshSerialize public ESMF_MeshDeserialize public ESMF_MeshFindPnt public ESMF_MeshGetElemArea public ESMF_MeshGetElemFrac public ESMF_MeshGetElemFrac2 public ESMF_MeshTurnOnCellMask public ESMF_MeshTurnOffCellMask public ESMF_MeshTurnOnNodeMask public ESMF_MeshTurnOffNodeMask public ESMF_MeshCreateDual ! not a public interface for now public ESMF_MeshSet public ESMF_MeshSetMOAB public ESMF_MeshGetMOAB public ESMF_MeshGetIntPtr public ESMF_MeshCreateFromIntPtr public ESMF_MeshCreateCubedSphere public ESMF_MeshEmptyCreate public ESMF_MeshCreateFromFileOld !EOPI !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ ! The following line turns the CVS identifier string into a printable variable. character(*), parameter, private :: version = & '$Id$' !============================================================================== ! ! INTERFACE BLOCKS ! !============================================================================== interface ESMF_MeshCreate module procedure ESMF_MeshCreate3Part module procedure ESMF_MeshCreate1Part module procedure ESMF_MeshCreateFromPointer module procedure ESMF_MeshCreateFromFile module procedure ESMF_MeshCreateFromDG module procedure ESMF_MeshCreateFromMeshes module procedure ESMF_MeshCreateRedist module procedure ESMF_MeshCreateEasyElemsGen module procedure ESMF_MeshCreateEasyElems1Type module procedure ESMF_MeshCreateFromGrid end interface !------------------------------------------------------------------------------ !BOPI ! !INTERFACE: interface assignment (=) module procedure ESMF_MeshLocToInt module procedure ESMF_IntToMeshLoc end interface ! !------------------------------------------------------------------------------ !BOPI ! !INTERFACE: interface operator (==) ! !PRIVATE MEMBER FUNCTIONS: module procedure ESMF_MeshLocEqual ! !DESCRIPTION: ! This interface overloads the equality operator for the specific ! ESMF MeshLoc. 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_MeshLocNotEqual ! !DESCRIPTION: ! This interface overloads the inequality operator for the specific ! ESMF MeshLoc. 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_MeshStatusEqual ! !DESCRIPTION: ! This interface overloads the equality operator for the specific ! ESMF MeshStatus. 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_MeshStatusNotEqual ! !DESCRIPTION: ! This interface overloads the inequality operator for the specific ! ESMF MeshStatus. It is provided for easy comparisons of ! these types with defined values. ! !EOPI end interface !=============================================================================== ! MeshOperator() interfaces !=============================================================================== ! -------------------------- ESMF-public method ------------------------------- !BOP ! !IROUTINE: ESMF_MeshAssignment(=) - Mesh assignment ! ! !INTERFACE: ! interface assignment(=) ! mesh1 = mesh2 ! ! !ARGUMENTS: ! type(ESMF_Mesh) :: mesh1 ! type(ESMF_Mesh) :: mesh2 ! ! ! !STATUS: ! \begin{itemize} ! \item\apiStatusCompatibleVersion{5.2.0r} ! \end{itemize} ! ! !DESCRIPTION: ! Assign mesh1 as an alias to the same ESMF Mesh object in memory ! as mesh2. If mesh2 is invalid, then mesh1 will be equally invalid after ! the assignment. ! ! The arguments are: ! \begin{description} ! \item[mesh1] ! The {\tt ESMF\_Mesh} object on the left hand side of the assignment. ! \item[mesh2] ! The {\tt ESMF\_Mesh} object on the right hand side of the assignment. ! \end{description} ! !EOP !------------------------------------------------------------------------------ ! -------------------------- ESMF-public method ------------------------------- !BOP ! !IROUTINE: ESMF_MeshOperator(==) - Mesh equality operator ! ! !INTERFACE: interface operator(==) ! if (mesh1 == mesh2) then ... endif ! OR ! result = (mesh1 == mesh2) ! !RETURN VALUE: ! logical :: result ! ! !ARGUMENTS: ! type(ESMF_Mesh), intent(in) :: mesh1 ! type(ESMF_Mesh), intent(in) :: mesh2 ! ! ! !STATUS: ! \begin{itemize} ! \item\apiStatusCompatibleVersion{5.2.0r} ! \end{itemize} ! ! !DESCRIPTION: ! Test whether mesh1 and mesh2 are valid aliases to the same ESMF ! Mesh object in memory. For a more general comparison of two ESMF Meshes, ! going beyond the simple alias test, the ESMF\_MeshMatch() function (not yet ! implemented) must be used. ! ! The arguments are: ! \begin{description} ! \item[mesh1] ! The {\tt ESMF\_Mesh} object on the left hand side of the equality ! operation. ! \item[mesh2] ! The {\tt ESMF\_Mesh} object on the right hand side of the equality ! operation. ! \end{description} ! !EOP module procedure ESMF_MeshEQ end interface !------------------------------------------------------------------------------ ! -------------------------- ESMF-public method ------------------------------- !BOP ! !IROUTINE: ESMF_MeshOperator(/=) - Mesh not equal operator ! ! !INTERFACE: interface operator(/=) ! if (mesh1 /= mesh2) then ... endif ! OR ! result = (mesh1 /= mesh2) ! !RETURN VALUE: ! logical :: result ! ! !ARGUMENTS: ! type(ESMF_Mesh), intent(in) :: mesh1 ! type(ESMF_Mesh), intent(in) :: mesh2 ! ! ! !STATUS: ! \begin{itemize} ! \item\apiStatusCompatibleVersion{5.2.0r} ! \end{itemize} ! ! !DESCRIPTION: ! Test whether mesh1 and mesh2 are {\it not} valid aliases to the ! same ESMF Mesh object in memory. For a more general comparison of two ESMF ! Meshes, going beyond the simple alias test, the ESMF\_MeshMatch() function ! (not yet implemented) must be used. ! ! The arguments are: ! \begin{description} ! \item[mesh1] ! The {\tt ESMF\_Mesh} object on the left hand side of the non-equality ! operation. ! \item[mesh2] ! The {\tt ESMF\_Mesh} object on the right hand side of the non-equality ! operation. ! \end{description} ! !EOP module procedure ESMF_MeshNE end interface !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ ! ! Interoperability interfaces #ifndef ESMF_NO_F2018ASSUMEDTYPE interface subroutine C_ESMC_MeshSetElemDistGrid(mesh, distgrid, rc) use ESMF_DistGridMod type(*) :: mesh type(ESMF_DistGrid) :: distgrid integer :: rc end subroutine end interface #endif !------------------------------------------------------------------------------ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine ESMF_MeshLocToInt(lhsInt, rhsMeshLoc) integer, intent(out) :: lhsInt type(ESMF_MeshLoc), intent(in) :: rhsMeshLoc lhsInt = rhsMeshLoc%meshloc end subroutine subroutine ESMF_IntToMeshLoc(lhsMeshLoc, rhsInt) type(ESMF_MeshLoc), intent(out) :: lhsMeshLoc integer, intent(in) :: rhsInt lhsMeshLoc = ESMF_MeshLoc(rhsInt) end subroutine !------------------------------------------------------------------------------- #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshEQ()" !BOPI ! !IROUTINE: ESMF_MeshEQ - Compare two Meshes for equality ! ! !INTERFACE: impure elemental function ESMF_MeshEQ(mesh1, mesh2) ! ! !RETURN VALUE: logical :: ESMF_MeshEQ ! !ARGUMENTS: type(ESMF_Mesh), intent(in) :: mesh1 type(ESMF_Mesh), intent(in) :: mesh2 ! !DESCRIPTION: ! Test if both {\tt mesh1} and {\tt mesh2} alias the same ESMF Mesh ! object. ! !EOPI !------------------------------------------------------------------------------- ESMF_INIT_TYPE minit1, minit2 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 minit1 = ESMF_MeshGetInit(mesh1) minit2 = ESMF_MeshGetInit(mesh2) ! TODO: this line must remain split in two for SunOS f90 8.3 127000-03 if (minit1 .eq. ESMF_INIT_CREATED .and. & minit2 .eq. ESMF_INIT_CREATED) then ESMF_MeshEQ = mesh1%this .eq. mesh2%this else ESMF_MeshEQ = ESMF_FALSE endif end function ESMF_MeshEQ !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshNE()" !BOPI ! !IROUTINE: ESMF_MeshNE - Compare two Meshes for non-equality ! ! !INTERFACE: impure elemental function ESMF_MeshNE(mesh1, mesh2) ! ! !RETURN VALUE: logical :: ESMF_MeshNE ! !ARGUMENTS: type(ESMF_Mesh), intent(in) :: mesh1 type(ESMF_Mesh), intent(in) :: mesh2 ! !DESCRIPTION: ! Test if both {\tt mesh1} and {\tt mesh2} alias the same ESMF Mesh ! object. ! ESMF_INIT_TYPE minit1, minit2 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_MeshNE = .not.ESMF_MeshEQ(mesh1, mesh2) end function ESMF_MeshNE !------------------------------------------------------------------------------- !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshAddElements()" !BOP ! !IROUTINE: ESMF_MeshAddElements - Add elements to a Mesh \label{sec:mesh:api:meshaddelements} ! ! !INTERFACE: subroutine ESMF_MeshAddElements(mesh, elementIds, elementTypes, & elementConn, elementMask, elementArea, elementCoords, & elementDistgrid, rc) ! ! !ARGUMENTS: type(ESMF_Mesh), intent(inout) :: mesh integer, intent(in) :: elementIds(:) integer, intent(in) :: elementTypes(:) integer, intent(in) :: elementConn(:) integer, intent(in), optional :: elementMask(:) real(ESMF_KIND_R8), intent(in), optional :: elementArea(:) real(ESMF_KIND_R8), intent(in), optional :: elementCoords(:) type(ESMF_DistGrid), intent(in), optional :: elementDistgrid integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! This call is the third and last part of the three part mesh create ! sequence and should be called after the mesh is created with {\tt ESMF\_MeshCreate()} ! (\ref{sec:mesh:api:meshcreate}) ! and after the nodes are added with {\tt ESMF\_MeshAddNodes()} (\ref{sec:mesh:api:meshaddnodes}). ! This call adds the elements to the ! mesh and finalizes the create. After this call the Mesh is usable, for ! example a Field may be built on the created Mesh object and ! this Field may be used in a {\tt ESMF\_FieldRegridStore()} call. ! ! The parameters to this call {\tt elementIds}, {\tt elementTypes}, and ! {\tt elementConn} describe the elements to be created. The description ! for a particular element lies at the same index location in {\tt elementIds} ! and {\tt elementTypes}. Each entry in {\tt elementConn} consists of the list of ! nodes used to create that element, so the connections for element $e$ in the ! {\tt elementIds} array will start at $number\_of\_nodes\_in\_element(1) + number\_of\_nodes\_in\_element(2) + ! \cdots + number\_of\_nodes\_in\_element(e-1) + 1$ in {\tt elementConn}. ! ! This call is {\em collective} across the current VM. ! ! \begin{description} ! \item [elementIds] ! An array containing the global ids of the elements to be created on this PET. ! This input consists of a 1D array the size of the number of elements on this PET. ! Each element id must be a number equal to or greater than 1. An id should be ! unique in the sense that different elements must have different ids (the same element ! that appears on different processors must have the same id). There may be gaps in the sequence ! of ids, but if these gaps are the same scale as the length of the sequence it can lead to ! inefficiencies when the Mesh is used (e.g. in {\tt ESMF\_FieldRegridStore()}). ! \item[elementTypes] ! An array containing the types of the elements to be created on this PET. The types used ! must be appropriate for the parametric dimension of the Mesh. Please see ! Section~\ref{const:meshelemtype} for the list of options. This input consists of ! a 1D array the size of the number of elements on this PET. ! \item[elementConn] ! An array containing the indexes of the sets of nodes to be connected together to form the ! elements to be created on this PET. The entries in this list are NOT node global ids, ! but rather each entry is a local index (1 based) into the list of nodes which were ! created on this PET by the previous {\tt ESMF\_MeshAddNodes()} call. ! In other words, an entry of 1 indicates that this element contains the node ! described by {\tt nodeIds(1)}, {\tt nodeCoords(1)}, etc. passed into the ! {\tt ESMF\_MeshAddNodes()} call on this PET. It is also ! important to note that the order of the nodes in an element connectivity list ! matters. Please see Section~\ref{const:meshelemtype} for diagrams illustrating ! the correct order of nodes in a element. This input consists of a 1D array with ! a total size equal to the sum of the number of nodes in each element on ! this PET. The number of nodes in each element is implied by its element type in ! {\tt elementTypes}. The nodes for each element ! are in sequence in this array (e.g. the nodes for element 1 are elementConn(1), ! elementConn(2), etc.). ! \item [{[elementMask]}] ! An array containing values which can be used for element masking. Which values indicate ! masking are chosen via the {\tt srcMaskValues} or {\tt dstMaskValues} arguments to ! {\tt ESMF\_FieldRegridStore()} call. This input consists of a 1D array the ! size of the number of elements on this PET. ! \item [{[elementArea]}] ! An array containing element areas. If not specified, the element areas are internally calculated. ! This input consists of a 1D array the size of the number of elements on this PET. ! {\bf NOTE:} ESMF doesn't currently do unit conversion on areas. If these areas are going to be used ! in a process that also involves the areas of another Grid or Mesh (e.g. conservative regridding), then ! it is the user's responsibility to make sure that the area units are consistent between the two sides. ! If ESMF calculates an area on the surface of a sphere, then it is in units of square radians. If ! it calculates the area for a Cartesian grid, then it is in the same units as the coordinates, but squared. ! \item[{[elementCoords]}] ! An array containing the physical coordinates of the elements to be created on this ! PET. This input consists of a 1D array the size of the number of elements on this PET times the Mesh's ! spatial dimension. The coordinates in this array are ordered ! so that the coordinates for an element lie in sequence in memory. (e.g. for a ! Mesh with spatial dimension 2, the coordinates for element 1 are in elementCoords(1) and ! elementCoords(2), the coordinates for element 2 are in elementCoords(3) and elementCoords(4), ! etc.). ! \item [{[elementDistgrid]}] ! If present, use this as the element Distgrid for the Mesh. ! The passed in Distgrid ! needs to contain a local set of sequence indices matching the set of local element ids (i.e. those in {\tt elementIds}). ! However, specifying an externally created Distgrid gives the user more control over aspects of ! the Distgrid containing those sequence indices (e.g. how they are broken into DEs). ! If not present, a 1D Distgrid will be created internally consisting of one DE per PET. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOP !------------------------------------------------------------------------------ integer :: localrc type(ESMF_Logical) :: isfree type(ESMF_MeshStatus_Flag) :: status integer :: sdim, pdim integer :: numNode, numElem type(ESMF_CoordSys_Flag):: coordSys integer :: num_elems, num_elementConn type(ESMF_InterArray) :: elementMaskII real(ESMF_KIND_R8) :: tmpArea(2) integer :: areaPresent real(ESMF_KIND_R8) :: tmpCoords(2) integer :: coordsPresent ! 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_MeshGetInit, mesh, rc) ESMF_INIT_CHECK_DEEP(ESMF_DistgridGetInit, elementDistgrid, rc) call C_ESMC_MeshGetIsFree(mesh, isfree) if (isfree == ESMF_TRUE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh internals have been freed", & ESMF_CONTEXT, rcToReturn=rc) return endif ! If we're at the wrong stage then complain call C_ESMC_MeshGetStatus(mesh, status) if (status .ne. ESMF_MESHSTATUS_NODESADDED) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- MeshAddNodes() should be called before this", & ESMF_CONTEXT, rcToReturn=rc) return endif ! get sizes of lists num_elems = size(elementIds) num_elementConn = size(elementConn) call C_ESMC_MeshGetDimensions(mesh, sdim, pdim, coordSys, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! If present make sure that elementCoords has the correct size if (present(elementCoords)) then if (size(elementCoords) .ne. sdim*num_elems) then call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & msg="- elementCoords input array is the wrong size.", & ESMF_CONTEXT, rcToReturn=rc) return endif endif ! Create interface int to wrap optional element mask elementMaskII = ESMF_InterArrayCreate(elementMask, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! set element area if it's present. if (present(elementCoords)) then if (present(elementArea)) then areaPresent=1 coordsPresent=1 call C_ESMC_MeshAddElements(mesh%this, num_elems, & elementIds, elementTypes, elementMaskII, & areaPresent, elementArea, & coordsPresent, elementCoords, & num_elementConn, elementConn, & coordSys, sdim, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else areaPresent=0 coordsPresent=1 call C_ESMC_MeshAddElements(mesh%this, num_elems, & elementIds, elementTypes, elementMaskII, & areaPresent, tmpArea, & coordsPresent, elementCoords, & num_elementConn, elementConn, & coordSys, sdim, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif else if (present(elementArea)) then areaPresent=1 coordsPresent=0 call C_ESMC_MeshAddElements(mesh%this, num_elems, & elementIds, elementTypes, elementMaskII, & areaPresent, elementArea, & coordsPresent, tmpCoords, & num_elementConn, elementConn, & coordSys, sdim, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else areaPresent=0 coordsPresent=0 call C_ESMC_MeshAddElements(mesh%this, num_elems, & elementIds, elementTypes, elementMaskII, & areaPresent, tmpArea, & coordsPresent, tmpCoords, & num_elementConn, elementConn, & coordSys, sdim, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif endif ! create node distgrid if it hasn't been set in ESMF_MeshAddNodes() call C_ESMC_MeshCreateNodeDistGrid(mesh, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set Element Distgrid if (.not. present(elementDistgrid)) then call C_ESMC_MeshCreateElemDistGrid(mesh, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else call C_ESMC_MeshSetElemDistGrid(mesh, elementDistgrid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Get rid of interface Int wrapper call ESMF_InterArrayDestroy(elementMaskII, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Change status call C_ESMC_MeshSetStatus(mesh, ESMF_MESHSTATUS_COMPLETE) if (present (rc)) rc = localrc end subroutine ESMF_MeshAddElements !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshAddNodes()" !BOP ! !IROUTINE: ESMF_MeshAddNodes - Add nodes to a Mesh \label{sec:mesh:api:meshaddnodes} ! ! !INTERFACE: subroutine ESMF_MeshAddNodes(mesh, nodeIds, nodeCoords, nodeOwners, & nodeMask, nodalDistgrid, rc) ! ! !ARGUMENTS: type(ESMF_Mesh), intent(inout) :: mesh integer, intent(in) :: nodeIds(:) real(ESMF_KIND_R8), intent(in) :: nodeCoords(:) integer, intent(in), optional :: nodeOwners(:) integer, intent(in), optional :: nodeMask(:) type(ESMF_DistGrid), intent(in), optional :: nodalDistgrid integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! This call is the second part of the three part mesh create ! sequence and should be called after the mesh's dimensions are set ! using {\tt ESMF\_MeshCreate()} (\ref{sec:mesh:api:meshcreate}). ! This call adds the nodes to the ! mesh. The next step is to call {\tt ESMF\_MeshAddElements()} (\ref{sec:mesh:api:meshaddelements}). ! ! The parameters to this call {\tt nodeIds}, {\tt nodeCoords}, and ! {\tt nodeOwners} describe the nodes to be created on this PET. ! The description for a particular node lies at the same index location in ! {\tt nodeIds} and {\tt nodeOwners}. Each entry ! in {\tt nodeCoords} consists of spatial dimension coordinates, so the coordinates ! for node $n$ in the {\tt nodeIds} array will start at $(n-1)*spatialDim+1$. ! ! \begin{description} ! \item [nodeIds] ! An array containing the global ids of the nodes to be created on this PET. ! This input consists of a 1D array the size of the number of nodes on this PET. ! Each node id must be a number equal to or greater than 1. An id should be ! unique in the sense that different nodes must have different ids (the same node ! that appears on different processors must have the same id). There may be gaps in the sequence ! of ids, but if these gaps are the same scale as the length of the sequence it can lead to ! inefficiencies when the Mesh is used (e.g. in {\tt ESMF\_FieldRegridStore()}). ! \item[nodeCoords] ! An array containing the physical coordinates of the nodes to be created on this ! PET. This input consists of a 1D array the size of the number of nodes on this PET times the Mesh's ! spatial dimension ({\tt spatialDim}). The coordinates in this array are ordered ! so that the coordinates for a node lie in sequence in memory. (e.g. for a ! Mesh with spatial dimension 2, the coordinates for node 1 are in nodeCoords(1) and ! nodeCoords(2), the coordinates for node 2 are in nodeCoords(3) and nodeCoords(4), ! etc.). ! \item[{[nodeOwners]}] ! An array containing the PETs that own the nodes to be created on this PET. ! If the node is shared with another PET, the value ! may be a PET other than the current one. Only nodes owned by this PET ! will have PET local entries in a Field created on the Mesh. This input consists of ! a 1D array the size of the number of nodes on this PET. If not provided by the user, ! then ESMF will calculate node ownership. ! \item [{[nodeMask]}] ! An array containing values which can be used for node masking. Which values indicate ! masking are chosen via the {\tt srcMaskValues} or {\tt dstMaskValues} arguments to ! {\tt ESMF\_FieldRegridStore()} call. This input consists of a 1D array the ! size of the number of nodes on this PET. ! \item [{[nodalDistgrid]}] ! If present, use this as the node Distgrid for the Mesh. ! The passed in Distgrid ! needs to contain a local set of sequence indices matching the set of local node ids (i.e. the ids in ! {\tt nodeIds} with {\tt nodeOwners} equal to the current PET). ! However, specifying an externally created Distgrid gives the user more control over aspects of ! the Distgrid containing those sequence indices (e.g. how they are broken into DEs). ! If not present, a 1D Distgrid will be created internally consisting of one DE per PET. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOP !------------------------------------------------------------------------------ integer :: localrc type(ESMF_Logical) :: isfree type(ESMF_MeshStatus_Flag) :: status integer :: num_nodes integer :: sdim, pdim, numNode type(ESMF_CoordSys_Flag):: coordSys type(ESMF_InterArray) :: nodeMaskII, nodeOwnersII ! 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_MeshGetInit, mesh, rc) ESMF_INIT_CHECK_DEEP(ESMF_DistgridGetInit, nodalDistgrid, rc) call C_ESMC_MeshGetIsFree(mesh, isfree) if (isfree == ESMF_TRUE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh internals have been freed", & ESMF_CONTEXT, rcToReturn=rc) return endif ! If we're at the wrong stage then complain call C_ESMC_MeshGetStatus(mesh, status) if (status .ne. ESMF_MESHSTATUS_STRUCTCREATED) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- MeshCreate() should be called before this", & ESMF_CONTEXT, rcToReturn=rc) return endif call C_ESMC_MeshGetDimensions(mesh, sdim, pdim, coordSys, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Create interface int to wrap optional node owners nodeOwnersII = ESMF_InterArrayCreate(nodeOwners, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Create interface int to wrap optional element mask nodeMaskII = ESMF_InterArrayCreate(nodeMask, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return num_nodes = size(nodeIds) call C_ESMC_MeshAddNodes(mesh%this, num_nodes, nodeIds, nodeCoords, & nodeOwnersII, nodeMaskII, & coordSys, sdim, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Get rid of interface Int wrappers call ESMF_InterArrayDestroy(nodeOwnersII, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterArrayDestroy(nodeMaskII, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set distgrid if was passed in if (present(nodalDistgrid)) then call c_ESMC_MeshSetNodeDistGrid(mesh, nodalDistgrid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Change status call C_ESMC_MeshSetStatus(mesh, ESMF_MESHSTATUS_NODESADDED) if (present (rc)) rc = localrc end subroutine ESMF_MeshAddNodes !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshCreate3Part()" !BOP ! !IROUTINE: ESMF_MeshCreate - Create a Mesh as a 3 step process \label{sec:mesh:api:meshcreate} ! ! !INTERFACE: ! Private name; call using ESMF_MeshCreate() function ESMF_MeshCreate3Part(parametricDim, spatialDim, coordSys, name, rc) ! ! ! !RETURN VALUE: type(ESMF_Mesh) :: ESMF_MeshCreate3Part ! !ARGUMENTS: integer, intent(in) :: parametricDim integer, intent(in) :: spatialDim type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys character(len=*), intent(in), optional :: name integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! This call is the first part of the three part mesh create ! sequence. This call sets the dimension of the elements in the mesh ! ({\tt parametricDim}) and the number of coordinate dimensions in the mesh ! ({\tt spatialDim}). The next step is to call {\tt ESMF\_MeshAddNodes()} (\ref{sec:mesh:api:meshaddnodes}) ! to add the nodes and then {\tt ESMF\_MeshAddElements()} (\ref{sec:mesh:api:meshaddelements}) to add ! the elements and finalize the mesh. ! ! This call is {\em collective} across the current VM. ! ! \begin{description} ! \item [parametricDim] ! Dimension of the topology of the Mesh. (E.g. a mesh constructed of squares would ! have a parametric dimension of 2, whereas a Mesh constructed of cubes would have one ! of 3.) ! \item[spatialDim] ! The number of coordinate dimensions needed to describe the locations of the nodes ! making up the Mesh. For a manifold, the spatial dimension can be larger than the ! parametric dim (e.g. the 2D surface of a sphere in 3D space), but it can't be smaller. ! \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 [{[name]}] ! The name of the Mesh. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOP !------------------------------------------------------------------------------ integer :: localrc type(ESMF_CoordSys_Flag) :: coordSysLocal ! initialize return code; assume routine not implemented localrc = ESMF_RC_NOT_IMPL if (present(rc)) rc = ESMF_RC_NOT_IMPL ! Set Default coordSys if (present(coordSys)) then coordSysLocal=coordSys else coordSysLocal=ESMF_COORDSYS_SPH_DEG endif ! Create C++ Mesh ESMF_MeshCreate3Part%this = ESMF_NULL_POINTER ! Optional name argument requires separate calls into C++ if (present(name)) then call C_ESMC_MeshCreate(ESMF_MeshCreate3Part%this, parametricDim, spatialDim, & coordSysLocal, name, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else call C_ESMC_MeshCreate(ESMF_MeshCreate3Part%this, parametricDim, spatialDim, & coordSysLocal, "", localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Go to next stage call C_ESMC_MeshSetStatus(ESMF_MeshCreate3Part, ESMF_MESHSTATUS_STRUCTCREATED) ! Set init status of arguments ESMF_INIT_SET_CREATED(ESMF_MeshCreate3Part) if (present (rc)) rc = localrc end function ESMF_MeshCreate3Part !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshCreate1Part()" !BOP ! !IROUTINE: ESMF_MeshCreate - Create a Mesh all at once ! ! !INTERFACE: ! Private name; call using ESMF_MeshCreate() function ESMF_MeshCreate1Part(parametricDim, spatialDim, & nodeIds, nodeCoords, nodeOwners, nodeMask, nodalDistgrid, & elementIds, elementTypes, elementConn, & elementMask, elementArea, elementCoords, & elementDistgrid, coordSys, name, rc) ! ! ! !RETURN VALUE: type(ESMF_Mesh) :: ESMF_MeshCreate1Part ! !ARGUMENTS: integer, intent(in) :: parametricDim integer, intent(in) :: spatialDim integer, intent(in) :: nodeIds(:) real(ESMF_KIND_R8), intent(in) :: nodeCoords(:) integer, intent(in), optional :: nodeOwners(:) integer, intent(in), optional :: nodeMask(:) type(ESMF_DistGrid), intent(in), optional :: nodalDistgrid integer, intent(in) :: elementIds(:) integer, intent(in) :: elementTypes(:) integer, intent(in) :: elementConn(:) integer, intent(in), optional :: elementMask(:) real(ESMF_KIND_R8), intent(in), optional :: elementArea(:) real(ESMF_KIND_R8), intent(in), optional :: elementCoords(:) type(ESMF_DistGrid), intent(in), optional :: elementDistgrid type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys character(len=*), intent(in), optional :: name integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Create a Mesh object in one step. After this call the Mesh is usable, for ! example, a Field may be built on the created Mesh object and ! this Field may be used in a {\tt ESMF\_FieldRegridStore()} call. ! ! This call sets the dimension of the elements in the mesh ! ({\tt parametricDim}) and the number of coordinate dimensions in the mesh ! ({\tt spatialDim}). It then creates the nodes, and ! then creates the elements by connecting together the nodes. ! ! The parameters to this call {\tt nodeIds}, {\tt nodeCoords}, and ! {\tt nodeOwners} describe the nodes to be created on this PET. ! The description for a particular node lies at the same index location in ! {\tt nodeIds} and {\tt nodeOwners}. Each entry ! in {\tt nodeCoords} consists of spatial dimension coordinates, so the coordinates ! for node $n$ in the {\tt nodeIds} array will start at $(n-1)*spatialDim+1$. ! ! The parameters to this call {\tt elementIds}, {\tt elementTypes}, and ! {\tt elementConn} describe the elements to be created. The description ! for a particular element lies at the same index location in {\tt elementIds} ! and {\tt elementTypes}. Each entry in {\tt elementConn} consists of the list of ! nodes used to create that element, so the connections for element $e$ in the ! {\tt elementIds} array will start at $number\_of\_nodes\_in\_element(1) + number\_of\_nodes\_in\_element(2) + ! \cdots + number\_of\_nodes\_in\_element(e-1) + 1$ in {\tt elementConn}. ! ! This call is {\em collective} across the current VM. ! ! \begin{description} ! \item [parametricDim] ! Dimension of the topology of the Mesh. (E.g. a mesh constructed of squares would ! have a parametric dimension of 2, whereas a Mesh constructed of cubes would have one ! of 3.) ! \item[spatialDim] ! The number of coordinate dimensions needed to describe the locations of the nodes ! making up the Mesh. For a manifold, the spatial dimension can be larger than the ! parametric dim (e.g. the 2D surface of a sphere in 3D space), but it can't be smaller. ! \item [nodeIds] ! An array containing the global ids of the nodes to be created on this PET. ! This input consists of a 1D array the size of the number of nodes on this PET. ! Each node id must be a number equal to or greater than 1. An id should be ! unique in the sense that different nodes must have different ids (the same node ! that appears on different processors must have the same id). There may be gaps in the sequence ! of ids, but if these gaps are the same scale as the length of the sequence it can lead to ! inefficiencies when the Mesh is used (e.g. in {\tt ESMF\_FieldRegridStore()}). ! \item[nodeCoords] ! An array containing the physical coordinates of the nodes to be created on this ! PET. This input consists of a 1D array the size of the number of nodes on this PET times the Mesh's ! spatial dimension ({\tt spatialDim}). The coordinates in this array are ordered ! so that the coordinates for a node lie in sequence in memory. (e.g. for a ! Mesh with spatial dimension 2, the coordinates for node 1 are in nodeCoords(1) and ! nodeCoords(2), the coordinates for node 2 are in nodeCoords(3) and nodeCoords(4), ! etc.). ! \item[{[nodeOwners]}] ! An array containing the PETs that own the nodes to be created on this PET. ! If the node is shared with another PET, the value ! may be a PET other than the current one. Only nodes owned by this PET ! will have PET local entries in a Field created on the Mesh. This input consists of ! a 1D array the size of the number of nodes on this PET. If not provided by the user, ! then ESMF will calculate node ownership. ! \item [{[nodeMask]}] ! An array containing values which can be used for node masking. Which values indicate ! masking are chosen via the {\tt srcMaskValues} or {\tt dstMaskValues} arguments to ! {\tt ESMF\_FieldRegridStore()} call. This input consists of a 1D array the ! size of the number of nodes on this PET. ! \item [{[nodalDistgrid]}] ! If present, use this as the node Distgrid for the Mesh. ! The passed in Distgrid ! needs to contain a local set of sequence indices matching the set of local node ids (i.e. the ids in ! {\tt nodeIds} with {\tt nodeOwners} equal to the current PET). ! However, specifying an externally created Distgrid gives the user more control over aspects of ! the Distgrid containing those sequence indices (e.g. how they are broken into DEs). ! If not present, a 1D Distgrid will be created internally consisting of one DE per PET. ! \item [elementIds] ! An array containing the global ids of the elements to be created on this PET. ! This input consists of a 1D array the size of the number of elements on this PET. ! Each element id must be a number equal to or greater than 1. An id should be ! unique in the sense that different elements must have different ids (the same element ! that appears on different processors must have the same id). There may be gaps in the sequence ! of ids, but if these gaps are the same scale as the length of the sequence it can lead to ! inefficiencies when the Mesh is used (e.g. in {\tt ESMF\_FieldRegridStore()}). ! \item[elementTypes] ! An array containing the types of the elements to be created on this PET. The types used ! must be appropriate for the parametric dimension of the Mesh. Please see ! Section~\ref{const:meshelemtype} for the list of options. This input consists of ! a 1D array the size of the number of elements on this PET. ! \item[elementConn] ! An array containing the indexes of the sets of nodes to be connected together to form the ! elements to be created on this PET. The entries in this list are NOT node global ids, ! but rather each entry is a local index (1 based) into the list of nodes to be ! created on this PET by this call. ! In other words, an entry of 1 indicates that this element contains the node ! described by {\tt nodeIds(1)}, {\tt nodeCoords(1)}, etc. on this PET. It is also ! important to note that the order of the nodes in an element connectivity list ! matters. Please see Section~\ref{const:meshelemtype} for diagrams illustrating ! the correct order of nodes in a element. This input consists of a 1D array with ! a total size equal to the sum of the number of nodes contained in each element on ! this PET. The number of nodes in each element is implied by its element type in ! {\tt elementTypes}. The nodes for each element ! are in sequence in this array (e.g. the nodes for element 1 are elementConn(1), ! elementConn(2), etc.). ! \item [{[elementMask]}] ! An array containing values which can be used for element masking. Which values indicate ! masking are chosen via the {\tt srcMaskValues} or {\tt dstMaskValues} arguments to ! {\tt ESMF\_FieldRegridStore()} call. This input consists of a 1D array the ! size of the number of elements on this PET. ! \item [{[elementArea]}] ! An array containing element areas. If not specified, the element areas are internally calculated. ! This input consists of a 1D array the size of the number of elements on this PET. ! {\bf NOTE:} ESMF doesn't currently do unit conversion on areas. If these areas are going to be used ! in a process that also involves the areas of another Grid or Mesh (e.g. conservative regridding), then ! it is the user's responsibility to make sure that the area units are consistent between the two sides. ! If ESMF calculates an area on the surface of a sphere, then it is in units of square radians. If ! it calculates the area for a Cartesian grid, then it is in the same units as the coordinates, but squared. ! \item[{[elementCoords]}] ! An array containing the physical coordinates of the elements to be created on this ! PET. This input consists of a 1D array the size of the number of elements on this PET times the Mesh's ! spatial dimension ({\tt spatialDim}). The coordinates in this array are ordered ! so that the coordinates for an element lie in sequence in memory. (e.g. for a ! Mesh with spatial dimension 2, the coordinates for element 1 are in elementCoords(1) and ! elementCoords(2), the coordinates for element 2 are in elementCoords(3) and elementCoords(4), ! etc.). ! \item [{[elementDistgrid]}] ! If present, use this as the element Distgrid for the Mesh. ! The passed in Distgrid ! needs to contain a local set of sequence indices matching the set of local element ids (i.e. those in {\tt elementIds}). ! However, specifying an externally created Distgrid gives the user more control over aspects of ! the Distgrid containing those sequence indices (e.g. how they are broken into DEs). ! If not present, a 1D Distgrid will be created internally consisting of one DE per PET. ! \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 [{[name]}] ! The name of the Mesh. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOP !------------------------------------------------------------------------------ integer :: localrc integer :: numNode, numElem integer :: num_nodes integer :: num_elems, num_elementConn type(ESMF_InterArray) :: elementMaskII, nodeMaskII type(ESMF_InterArray) :: nodeOwnersII real(ESMF_KIND_R8) :: tmpArea(2) integer :: areaPresent real(ESMF_KIND_R8) :: tmpCoords(2) integer :: coordsPresent type(ESMF_CoordSys_Flag) :: coordSysLocal ! initialize return code; assume routine not implemented localrc = ESMF_RC_NOT_IMPL if (present(rc)) rc = ESMF_RC_NOT_IMPL ESMF_MeshCreate1Part%this = ESMF_NULL_POINTER ! Check init status of arguments ESMF_INIT_CHECK_DEEP(ESMF_DistgridGetInit, nodalDistgrid, rc) ESMF_INIT_CHECK_DEEP(ESMF_DistgridGetInit, elementDistgrid, rc) ! Set Default coordSys if (present(coordSys)) then coordSysLocal=coordSys else coordSysLocal=ESMF_COORDSYS_SPH_DEG endif ! Create C++ Mesh ! Optional name argument requires separate calls into C++ if (present(name)) then call C_ESMC_MeshCreate(ESMF_MeshCreate1Part%this, parametricDim, spatialDim, & coordSyslocal, name, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else call C_ESMC_MeshCreate(ESMF_MeshCreate1Part%this, parametricDim, spatialDim, & coordSyslocal, "", localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Set init status of arguments ESMF_INIT_SET_CREATED(ESMF_MeshCreate1Part) ! Create interface int to wrap optional node owners nodeOwnersII = ESMF_InterArrayCreate(nodeOwners, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Create interface int to wrap optional node mask nodeMaskII = ESMF_InterArrayCreate(nodeMask, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Add the nodes num_nodes = size(nodeIds) call C_ESMC_MeshAddNodes(ESMF_MeshCreate1Part%this, num_nodes, nodeIds, nodeCoords, & nodeOwnersII, nodeMaskII, & coordSysLocal, spatialDim, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Get rid of interface Int wrappers call ESMF_InterArrayDestroy(nodeOwnersII, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterArrayDestroy(nodeMaskII, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Create interface int to wrap optional element mask elementMaskII = ESMF_InterArrayCreate(elementMask, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! get sizes of lists num_elems = size(elementIds) num_elementConn = size(elementConn) ! If present make sure that elementCoords has the correct size if (present(elementCoords)) then if (size(elementCoords) .ne. & spatialDim*num_elems) then call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & msg="- elementCoords input array is the wrong size.", & ESMF_CONTEXT, rcToReturn=rc) return endif endif #if 0 call C_ESMC_MeshAddElements(ESMF_MeshCreate1Part%this, num_elems, & elementIds, elementTypes, elementMaskII, & num_elementConn, elementConn, & localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return #endif ! set element area if it's present. if (present(elementCoords)) then if (present(elementArea)) then areaPresent=1 coordsPresent=1 call C_ESMC_MeshAddElements(ESMF_MeshCreate1Part%this, & num_elems, & elementIds, elementTypes, elementMaskII, & areaPresent, elementArea, & coordsPresent, elementCoords, & num_elementConn, elementConn, & coordSysLocal, spatialDim, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else areaPresent=0 coordsPresent=1 call C_ESMC_MeshAddElements(ESMF_MeshCreate1Part%this, & num_elems, & elementIds, elementTypes, elementMaskII, & areaPresent, tmpArea, & coordsPresent, elementCoords, & num_elementConn, elementConn, & coordSysLocal, spatialDim, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif else if (present(elementArea)) then areaPresent=1 coordsPresent=0 call C_ESMC_MeshAddElements(ESMF_MeshCreate1Part%this, & num_elems, & elementIds, elementTypes, elementMaskII, & areaPresent, elementArea, & coordsPresent, tmpCoords, & num_elementConn, elementConn, & coordSysLocal, spatialDim, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else areaPresent=0 coordsPresent=0 call C_ESMC_MeshAddElements(ESMF_MeshCreate1Part%this, & num_elems, & elementIds, elementTypes, elementMaskII, & areaPresent, tmpArea, & coordsPresent, tmpCoords, & num_elementConn, elementConn, & coordSysLocal, spatialDim, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif endif ! Create two distgrids, one for nodes and one for elements if (present(nodalDistgrid)) then call c_ESMC_MeshSetNodeDistGrid(ESMF_MeshCreate1Part, nodalDistgrid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else call C_ESMC_MeshCreateNodeDistGrid(ESMF_MeshCreate1Part, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif if (present(elementDistgrid)) then call c_ESMC_MeshSetElemDistGrid(ESMF_MeshCreate1Part, elementDistgrid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else call C_ESMC_MeshCreateElemDistGrid(ESMF_MeshCreate1Part, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Get rid of interface Int wrapper call ESMF_InterArrayDestroy(elementMaskII, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set Status call C_ESMC_MeshSetStatus(ESMF_MeshCreate1Part, ESMF_MESHSTATUS_COMPLETE) if (present (rc)) rc = localrc end function ESMF_MeshCreate1Part !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshCreateFromDG()" !BOPI ! !IROUTINE: ESMF_MeshCreate - Create a Mesh from an elemental DistGrid ! ! !INTERFACE: ! Private name; call using ESMF_MeshCreate() function ESMF_MeshCreateFromDG(distgrid, nodalDistgrid, parametricDim, & spatialDim, coordSys, name, rc) ! ! ! !RETURN VALUE: type(ESMF_Mesh) :: ESMF_MeshCreateFromDG ! !ARGUMENTS: type(ESMF_DistGrid), intent(in) :: distgrid type(ESMF_DistGrid), intent(in), optional :: nodalDistgrid integer, intent(in), optional :: parametricDim integer, intent(in), optional :: spatialDim type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys character(len=*), intent(in), optional :: name integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Create a Mesh from an elemental distgrid. Such a mesh will have no coordinate or ! connectivity information stored. ! ! \begin{description} ! \item [distgrid] ! The elemental distgrid. ! \item [{[nodalDistgrid]}] ! The nodal distgrid, if not specified is set to distgrid (i.e. the elemental distgrid). ! \item [{[parametricDim]}] ! Dimension of the topology of the Mesh. (E.g. a mesh constructed of squares would ! have a parametric dimension of 2, whereas a Mesh constructed of cubes would have one ! of 3.) ! \item [{[spatialDim]}] ! The number of coordinate dimensions needed to describe the locations of the nodes ! making up the Mesh. For a manifold, the spatial dimension can be larger than the ! parametric dim (e.g. the 2D surface of a sphere in 3D space), but it can't be smaller. ! \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 [{[name]}] ! The name of the Mesh. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc integer ::l_pdim, l_sdim type(ESMF_CoordSys_Flag) :: coordSysLocal l_pdim = 2 l_sdim = 3 if(present(parametricDim)) l_pdim = parametricDim if(present(spatialDim)) l_sdim = spatialDim ! Set Default coordSys if (present(coordSys)) then coordSysLocal=coordSys else coordSysLocal=ESMF_COORDSYS_SPH_DEG endif ESMF_MeshCreateFromDG = ESMF_MeshCreate3part(l_pdim, l_sdim, & coordSysLocal, name=name, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set information call c_ESMC_MeshSetElemDistGrid(ESMF_MeshCreateFromDG, distgrid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return if (present(nodalDistgrid)) then call c_ESMC_MeshSetNodeDistGrid(ESMF_MeshCreateFromDG, nodalDistgrid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else call c_ESMC_MeshSetNodeDistGrid(ESMF_MeshCreateFromDG, distgrid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Set Status call C_ESMC_MeshSetStatus(ESMF_MeshCreateFromDG, ESMF_MESHSTATUS_COMPLETE) ! Set MeshCap::isfree call C_ESMC_MeshSetIsFree(ESMF_MeshCreateFromDG) ESMF_INIT_SET_CREATED(ESMF_MeshCreateFromDG) if (present(rc)) rc=ESMF_SUCCESS return end function ESMF_MeshCreateFromDG !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshCreateFromGrid()" !BOP ! !IROUTINE: ESMF_MeshCreate - Create a Mesh from a Grid ! ! !INTERFACE: ! Private name; call using ESMF_MeshCreate() function ESMF_MeshCreateFromGrid(grid, name, rc) ! ! ! !RETURN VALUE: type(ESMF_Mesh) :: ESMF_MeshCreateFromGrid ! !ARGUMENTS: type(ESMF_Grid), intent(in) :: grid character(len=*), intent(in), optional :: name integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Create an ESMF Mesh from an ESMF Grid. This method creates the elements of ! the Mesh from the cells of the Grid, and the nodes of the Mesh from the corners of ! the Grid. Corresponding locations in the Grid and new Mesh will have the same ! coordinates, sequence indices, masking, and area information. ! ! This method currently only works for 2D Grids. In addition, this method requires ! the input Grid to have coordinates in the corner stagger location. ! ! \begin{description} ! \item [grid] ! The ESMF Grid from which to create the Mesh. ! \item [{[name]}] ! The name of the Mesh. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOP !------------------------------------------------------------------------------ integer :: localrc integer :: numNode, numElem ! Create C side Mesh ! Optional name argument requires separate calls into C++ if (present(name)) then call C_ESMC_MeshCreateFromGrid(ESMF_MeshCreateFromGrid%this, & grid, name, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else call C_ESMC_MeshCreateFromGrid(ESMF_MeshCreateFromGrid%this, & grid, "", localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! these should be set inside MeshCap ! Create nodal distgrid call C_ESMC_MeshCreateNodeDistGrid(ESMF_MeshCreateFromGrid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Create element distgrid call C_ESMC_MeshCreateElemDistGrid(ESMF_MeshCreateFromGrid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set Status call C_ESMC_MeshSetStatus(ESMF_MeshCreateFromGrid, ESMF_MESHSTATUS_COMPLETE) ! Set init status of mesh ESMF_INIT_SET_CREATED(ESMF_MeshCreateFromGrid) ! Return success if (present(rc)) rc=ESMF_SUCCESS return end function ESMF_MeshCreateFromGrid !------------------------------------------------------------------------------ !!------------------------------------------------------------------------------ !#undef ESMF_METHOD !#define ESMF_METHOD "ESMF_MeshCreateFromMeshesR4()" !!BOPI !! !IROUTINE: ESMF_MeshCreate - Create a Mesh from two source Meshes with spatial operations !! !! !INTERFACE: ! ! Private name; call using ESMF_MeshCreate() ! function ESMF_MeshCreateFromMeshesR4(MeshA, MeshB, MeshOp, areaThreshold, rc) !! !! !! !RETURN VALUE: ! type(ESMF_Mesh) :: ESMF_MeshCreateFromMeshesR4 !! !ARGUMENTS: ! type(ESMF_Mesh), intent(in) :: MeshA ! type(ESMF_Mesh), intent(in) :: MeshB ! type(ESMF_MeshOp_Flag), intent(in) :: MeshOp ! real(ESMF_KIND_R4), intent(in), optional :: areaThreshold ! integer, intent(out), optional :: rc !! !! !DESCRIPTION: !! Create a Mesh from two source Meshes with spatial operations. These spatial operations !! treat the points in the two Meshes as point sets. The returned Mesh is either intersection, !! union, or difference of the point sets of two source Meshes. !! !! \begin{description} !! \item [MeshA] !! The first source Mesh containing the first point set. !! \item [MeshB] !! The second source Mesh containing the second point set. !! \item [MeshOp] !! Mesh spatial operation flag. Currently only ESMF_MESHOP_DIFFERENCE is supported. !! Please refer to section {\ref const:meshop} !! \item [areaThreshold] !! Minimum cell area to be accepted to create the resulting Mesh. Cells with area !! less than this threshold value are discarded. This is a user tunable parameter !! to handle roundoff error when computing with floating point numbers. The default !! value is 0. !! \item [{[rc]}] !! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. !! \end{description} !! !!EOPI !!------------------------------------------------------------------------------ ! integer :: localrc ! real(ESMF_KIND_R8) :: l_threshold ! ! l_threshold = 0. ! if(present(areaThreshold)) l_threshold = areaThreshold ! ! call C_ESMC_MeshCreateFromMeshes(meshA, meshB, ESMF_MeshCreateFromMeshesR4, & ! MeshOp, l_threshold, localrc) ! if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ! ESMF_CONTEXT, rcToReturn=rc)) return ! ! ! Set as fully created! ! ESMF_MeshCreateFromMeshesR4%isFullyCreated=.true. ! ! ESMF_INIT_SET_CREATED(ESMF_MeshCreateFromMeshesR4) ! ! if (present(rc)) rc=ESMF_SUCCESS ! return ! !end function ESMF_MeshCreateFromMeshesR4 !------------------------------------------------------------------------------ !!------------------------------------------------------------------------------ !#undef ESMF_METHOD !#define ESMF_METHOD "ESMF_MeshCreateFromMeshesR8()" !!BOPI !! !IROUTINE: ESMF_MeshCreate - Create a Mesh from two source Meshes with spatial operations !! !! !INTERFACE: ! ! Private name; call using ESMF_MeshCreate() ! function ESMF_MeshCreateFromMeshesR8(MeshA, MeshB, MeshOp, areaThreshold, rc) !! !! !! !RETURN VALUE: ! type(ESMF_Mesh) :: ESMF_MeshCreateFromMeshesR8 !! !ARGUMENTS: ! type(ESMF_Mesh), intent(in) :: MeshA ! type(ESMF_Mesh), intent(in) :: MeshB ! type(ESMF_MeshOp_Flag), intent(in) :: MeshOp ! real(ESMF_KIND_R8), intent(in), optional :: areaThreshold ! integer, intent(out), optional :: rc !! !! !DESCRIPTION: !! Create a Mesh from two source Meshes with spatial operations. These spatial operations !! treat the points in the two Meshes as point sets. The returned Mesh is either intersection, !! union, or difference of the point sets of two source Meshes. !! !! \begin{description} !! \item [MeshA] !! The first source Mesh containing the first point set. !! \item [MeshB] !! The second source Mesh containing the second point set. !! \item [MeshOp] !! Mesh spatial operation flag. Currently only ESMF_MESHOP_DIFFERENCE is supported. !! Please refer to section {\ref const:meshop} !! \item [areaThreshold] !! Minimum cell area to be accepted to create the resulting Mesh. Cells with area !! less than this threshold value are discarded. This is a user tunable parameter !! to handle roundoff error when computing with floating point numbers. The default !! value is 0. !! \item [{[rc]}] !! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. !! \end{description} !! !!EOPI !!------------------------------------------------------------------------------ ! integer :: localrc ! real(ESMF_KIND_R8) :: l_threshold ! ! l_threshold = 0. ! if(present(areaThreshold)) l_threshold = areaThreshold ! ! call C_ESMC_MeshCreateFromMeshes(meshA, meshB, ESMF_MeshCreateFromMeshesR8, & ! MeshOp, l_threshold, localrc) ! if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ! ESMF_CONTEXT, rcToReturn=rc)) return ! ! Set as fully created! ! ESMF_MeshCreateFromMeshesR8%isFullyCreated=.true. ! ! ESMF_INIT_SET_CREATED(ESMF_MeshCreateFromMeshesR8) ! ! if (present(rc)) rc=ESMF_SUCCESS ! return ! !end function ESMF_MeshCreateFromMeshesR8 !!------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshCreateFromMeshes()" !BOPI ! !IROUTINE: ESMF_MeshCreate - Create a Mesh from two source Meshes with spatial operations ! ! !INTERFACE: ! Private name; call using ESMF_MeshCreate() function ESMF_MeshCreateFromMeshes(MeshA, MeshB, MeshOp, areaThreshold, name, rc) ! ! ! !RETURN VALUE: type(ESMF_Mesh) :: ESMF_MeshCreateFromMeshes ! !ARGUMENTS: type(ESMF_Mesh), intent(in) :: MeshA type(ESMF_Mesh), intent(in) :: MeshB type(ESMF_MeshOp_Flag), intent(in) :: MeshOp real(ESMF_KIND_R8), intent(in), optional :: areaThreshold character(len=*), intent(in), optional :: name integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Create a Mesh from two source Meshes with spatial operations. These spatial operations ! treat the points in the two Meshes as point sets. The returned Mesh is either intersection, ! union, or difference of the point sets of two source Meshes. ! ! \begin{description} ! \item [MeshA] ! The first source Mesh containing the first point set. ! \item [MeshB] ! The second source Mesh containing the second point set. ! \item [MeshOp] ! Mesh spatial operation flag. Currently only ESMF_MESHOP_DIFFERENCE is supported. ! Please refer to section {\ref const:meshop} ! \item [areaThreshold] ! Minimum cell area to be accepted to create the resulting Mesh. Cells with area ! less than this threshold value are discarded. This is a user tunable parameter ! to handle roundoff error when computing with floating point numbers. The default ! value is 0. ! \item [{[name]}] ! The name of the Mesh. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc integer :: numNode, numElem real(ESMF_KIND_R8) :: l_threshold l_threshold = 0. if(present(areaThreshold)) l_threshold = areaThreshold call C_ESMC_MeshCreateFromMeshes(meshA, meshB, ESMF_MeshCreateFromMeshes, & MeshOp, l_threshold, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! these should be set inside MeshCap ! Create two distgrids, one for nodes and one for elements call C_ESMC_MeshCreateNodeDistGrid(ESMF_MeshCreateFromMeshes, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call C_ESMC_MeshCreateElemDistGrid(ESMF_MeshCreateFromMeshes, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set Status call C_ESMC_MeshSetStatus(ESMF_MeshCreateFromMeshes, ESMF_MESHSTATUS_COMPLETE) ! Set the name in Base object if (present(name)) then call c_ESMC_SetName(ESMF_MeshCreateFromMeshes, "Mesh", name, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ESMF_INIT_SET_CREATED(ESMF_MeshCreateFromMeshes) if (present(rc)) rc=ESMF_SUCCESS return end function ESMF_MeshCreateFromMeshes !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshCreateFromFile()" !BOP !\label{API:MeshCreateFromFile} ! !IROUTINE: ESMF_MeshCreate - Create a Mesh from a file ! ! !INTERFACE: ! Private name; call using ESMF_MeshCreate() function ESMF_MeshCreateFromFile(filename, fileformat, keywordEnforcer, & convertToDual, addUserArea, maskFlag, varname, & nodalDistgrid, elementDistgrid, & coordSys, name, rc) ! ! ! !RETURN VALUE: type(ESMF_Mesh) :: ESMF_MeshCreateFromFile ! !ARGUMENTS: character(len=*), intent(in) :: filename type(ESMF_FileFormat_Flag), intent(in) :: fileformat type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below logical, intent(in), optional :: convertToDual logical, intent(in), optional :: addUserArea type(ESMF_MeshLoc), intent(in), optional :: maskFlag character(len=*), intent(in), optional :: varname type(ESMF_DistGrid), intent(in), optional :: nodalDistgrid type(ESMF_DistGrid), intent(in), optional :: elementDistgrid type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys character(len=*), intent(in), optional :: name integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Create a Mesh from a file. Provides options to convert to 3D and in the case of SCRIP ! format files, allows the dual of the mesh to be created. ! ! This call is {\em collective} across the current VM. ! ! \begin{description} ! \item [filename] ! The name of the grid file ! \item[fileformat] ! The file format. The valid options are {\tt ESMF\_FILEFORMAT\_SCRIP}, {\tt ESMF\_FILEFORMAT\_ESMFMESH} and ! {\tt ESMF\_FILEFORMAT\_UGRID}. ! Please see Section~\ref{const:fileformatflag} for a detailed description of the options. ! \item[{[convertToDual]}] ! if {\tt .true.}, the mesh will be converted to its dual. If not specified, ! defaults to {\tt .false.}. ! \item[{[addUserArea]}] ! if {\tt .true.}, the cell area will be read in from the GRID file. This feature is ! only supported when the grid file is in the SCRIP or ESMF format. If not specified, ! defaults to {\tt .false.}. ! \item[{[maskFlag]}] ! If maskFlag is present, generate the mask using the missing\_value attribute defined in 'varname' ! This flag is only supported when the grid file is in the UGRID format. ! The value could be either {\tt ESMF\_MESHLOC\_NODE} or {\tt ESMF\_MESHLOC\_ELEMENT}. If the value is ! {\tt ESMF\_MESHLOC\_NODE}, the node mask will be generated and the variable has to be ! defined on the "node" (specified by its {\tt location} attribute). If the value is ! {\tt ESMF\_MESHLOC\_ELEMENT}, the element mask will be generated and the variable has to be ! defined on the "face" of the mesh. If the variable is not defined on the right location, ! no mask will be generated. If not specified, no mask will be generated. ! \item[{[varname]}] ! If maskFlag is present, provide a variable name stored in the UGRID 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. If not ! specified, defaults to empty string. ! \item [{[nodalDistgrid]}] ! A Distgrid describing the user-specified distribution of ! the nodes across the PETs. ! \item [{[elementDistgrid]}] ! A Distgrid describing the user-specified distribution of ! the elements across the PETs. ! \item[{[coordSys]}] ! The coordinate system in which to store the mesh coordinate data. ! If this setting doesn't match the coordinate system in the file, then ! the coordinates in the file will be converted to this system during mesh ! creation. It is currently an error to convert Cartesian file coordinates ! into a spherical coordinate system. ! For a full list of options, please see Section~\ref{const:coordsys}. ! If not specified, then defaults to the coordinate system in the file. ! \item [{[name]}] ! The name of the Mesh. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOP !------------------------------------------------------------------------------ type(ESMF_Mesh) :: myMesh integer:: localrc type(ESMF_Logical) :: localAddUserArea type(ESMF_Logical) :: localConvertToDual type(ESMF_CoordSys_Flag) :: localCoordSys type(ESMF_MeshLoc) :: localMaskFlag ! Check init status of arguments ESMF_INIT_CHECK_DEEP(ESMF_DistgridGetInit, nodalDistgrid, rc) ESMF_INIT_CHECK_DEEP(ESMF_DistgridGetInit, elementDistgrid, rc) ! Process optional arguments and at the same time convert to a format to go through to C localAddUserArea=ESMF_FALSE if (present(addUserArea)) then localAddUserArea=addUserArea endif localConvertToDual=ESMF_FALSE if (present(convertToDual)) then localConvertToDual=convertToDual endif localCoordSys=ESMF_COORDSYS_UNINIT if (present(coordSys)) then localCoordSys=coordSys endif localMaskFlag=ESMF_MESHLOC_NONE if (present(maskFlag)) then localMaskFlag=maskFlag endif ! Call into C call c_ESMC_MeshCreateFromFile(ESMF_MeshCreateFromFile%this, & filename, fileformat, & localConvertToDual, localAddUserArea, & localCoordSys, & localMaskFlag, varname, & nodalDistgrid, elementDistgrid, & localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set nodeDistgrid in Mesh if (present(nodalDistgrid)) then call c_ESMC_MeshSetNodeDistGrid(ESMF_MeshCreateFromFile, nodalDistgrid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else call C_ESMC_MeshCreateNodeDistGrid(ESMF_MeshCreateFromFile, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Set elementDistgrid in Mesh if (present(elementDistgrid)) then call c_ESMC_MeshSetElemDistGrid(ESMF_MeshCreateFromFile, elementDistgrid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else call C_ESMC_MeshCreateElemDistGrid(ESMF_MeshCreateFromFile, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Set the name in Base object ! Do this here for now, but eventually move into above C func if (present(name)) then call c_ESMC_SetName(ESMF_MeshCreateFromFile, "Mesh", name, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Change status call C_ESMC_MeshSetStatus(ESMF_MeshCreateFromFile, ESMF_MESHSTATUS_COMPLETE) ! Set init status of arguments ESMF_INIT_SET_CREATED(ESMF_MeshCreateFromFile) ! Return success if (present(rc)) rc=ESMF_SUCCESS end function ESMF_MeshCreateFromFile !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshCreateFromFileOld()" !BOPI !\label{API:MeshCreateFromFileOld} ! !IROUTINE: ESMF_MeshCreate - Previous version of Mesh create from a file ! ! !INTERFACE: function ESMF_MeshCreateFromFileOld(filename, fileformat, keywordEnforcer, & convertToDual, addUserArea, maskFlag, varname, & nodalDistgrid, elementDistgrid, name, rc) ! ! ! !RETURN VALUE: type(ESMF_Mesh) :: ESMF_MeshCreateFromFileOld ! !ARGUMENTS: character(len=*), intent(in) :: filename type(ESMF_FileFormat_Flag), intent(in) :: fileformat type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below logical, intent(in), optional :: convertToDual logical, intent(in), optional :: addUserArea type(ESMF_MeshLoc), intent(in), optional :: maskFlag character(len=*), intent(in), optional :: varname type(ESMF_DistGrid), intent(in), optional :: nodalDistgrid type(ESMF_DistGrid), intent(in), optional :: elementDistgrid character(len=*), intent(in), optional :: name integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! ! {\em WARNING:} This is the deprecated ESMF\_MeshCreateFromFileOld() interface. It is being kept ! as a backup during the 8.3 release in case there are issues with the new implementation. However, ! this interface will be removed in the 8.4 release. ! ! Create a Mesh from a file. Provides options to convert to 3D and in the case of SCRIP ! format files, allows the dual of the mesh to be created. ! ! This call is {\em collective} across the current VM. ! ! \begin{description} ! \item [filename] ! The name of the grid file ! \item[fileformat] ! The file format. The valid options are {\tt ESMF\_FILEFORMAT\_SCRIP}, {\tt ESMF\_FILEFORMAT\_ESMFMESH} and ! {\tt ESMF\_FILEFORMAT\_UGRID}. ! Please see Section~\ref{const:fileformatflag} for a detailed description of the options. ! \item[{[convertToDual]}] ! if {\tt .true.}, the mesh will be converted to its dual. If not specified, ! defaults to {\tt .false.}. ! \item[{[addUserArea]}] ! if {\tt .true.}, the cell area will be read in from the GRID file. This feature is ! only supported when the grid file is in the SCRIP or ESMF format. If not specified, ! defaults to {\tt .false.}. ! \item[{[maskFlag]}] ! If maskFlag is present, generate the mask using the missing\_value attribute defined in 'varname' ! This flag is only supported when the grid file is in the UGRID format. ! The value could be either {\tt ESMF\_MESHLOC\_NODE} or {\tt ESMF\_MESHLOC\_ELEMENT}. If the value is ! {\tt ESMF\_MESHLOC\_NODE}, the node mask will be generated and the variable has to be ! defined on the "node" (specified by its {\tt location} attribute). If the value is ! {\tt ESMF\_MESHLOC\_ELEMENT}, the element mask will be generated and the variable has to be ! defined on the "face" of the mesh. If the variable is not defined on the right location, ! no mask will be generated. If not specified, no mask will be generated. ! \item[{[varname]}] ! If maskFlag is present, provide a variable name stored in the UGRID 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. If not ! specified, defaults to empty string. ! \item [{[nodalDistgrid]}] ! A Distgrid describing the user-specified distribution of ! the nodes across the PETs. ! \item [{[elementDistgrid]}] ! A Distgrid describing the user-specified distribution of ! the elements across the PETs. ! \item [{[name]}] ! The name of the Mesh. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ logical:: localConvertToDual ! local flag logical:: localAddUserArea type(ESMF_Mesh) :: myMesh integer:: localrc ! Set Defaults if (present(convertToDual)) then localConvertToDual = convertToDual else localConvertToDual = .false. endif if (present(addUserArea)) then localAddUserArea = addUserArea else localAddUserArea = .false. endif if (present(maskFlag) .and. .not. present(varname)) then call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & msg="- need varname argument to create mask", & ESMF_CONTEXT, rcToReturn=rc) return endif if (fileformat == ESMF_FILEFORMAT_SCRIP) then myMesh = ESMF_MeshCreateFromScrip(filename, localConvertToDual, & addUserArea=localAddUserArea, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return elseif (fileformat == ESMF_FILEFORMAT_ESMFMESH) then myMesh = ESMF_MeshCreateFromUnstruct(filename, & addUserArea=localAddUserArea, & convertToDual=localConvertToDual, & fileformat=fileformat, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return elseif (fileformat == ESMF_FILEFORMAT_UGRID) then ! Warning message about add user area if (localAddUserArea) then call ESMF_LogWrite("ESMF does not currently support " // & "user areas in UGRID format, so user areas will " // & "not be used for the UGRID file.", & ESMF_LOGMSG_WARNING, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif if (present(maskFlag)) then myMesh = ESMF_MeshCreateFromUnstruct(filename, & fileformat=fileformat, & convertToDual=localConvertToDual, & maskFlag=maskFlag, varname=varname, & rc=localrc) else myMesh = ESMF_MeshCreateFromUnstruct(filename, & fileformat=fileformat, & convertToDual=localConvertToDual, & rc=localrc) endif if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & msg="- unrecognized fileformat", & ESMF_CONTEXT, rcToReturn=rc) return endif if (present(elementDistgrid) .and. present(nodalDistgrid)) then ESMF_MeshCreateFromFileOld = ESMF_MeshCreateRedist(myMesh, & nodalDistgrid=nodalDistgrid, & elementDistgrid=elementDistgrid, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_MeshDestroy(myMesh) elseif (present(elementDistgrid)) then ESMF_MeshCreateFromFileOld = ESMF_MeshCreateRedist(myMesh, & elementDistgrid=elementDistgrid, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_MeshDestroy(myMesh) elseif (present(nodalDistgrid)) then ESMF_MeshCreateFromFileOld = ESMF_MeshCreateRedist(myMesh, & nodalDistgrid=nodalDistgrid, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_MeshDestroy(myMesh) else ESMF_MeshCreateFromFileOld = myMesh endif ! Set the name in Base object if (present(name)) then call c_ESMC_SetName(ESMF_MeshCreateFromFileOld, "Mesh", name, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif if (present(rc)) rc=ESMF_SUCCESS return end function ESMF_MeshCreateFromFileOld !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshCreateFromUnstruct()" !BOPI ! !IROUTINE: ESMF_MeshCreate - Create a Mesh from a grid file defined in the ESMF Unstructured ! Grid format ! Create a triangle and quad mesh using a global node coordinate table and a distributed ! element connection array ! arguments: VertexCoords(3, NodeCnt), where NodeCnt is the total node count for the ! global mesh, the first dimension stores the x,y,z coordinates of the node ! CellConnect(4, ElemCnt), where ElemCnt is the total number of elements ! The first dimension contains the global node IDs at the four corner of the element ! StartCell, the first Element ID in this PET ! in this local PET. Note the CellConnect is local and VertexCoords is global. ! In this routine, we have to figure out which nodes are used by the local Elements ! and who are the owners of the local nodes, then add the local nodes and elements into ! the mesh ! !INTERFACE: ! Private name; call using ESMF_MeshCreate() function ESMF_MeshCreateFromUnstruct(filename, convertToDual, fileformat, meshname, & addUserArea, maskFlag, varname, rc) ! ! ! !RETURN VALUE: type(ESMF_Mesh) :: ESMF_MeshCreateFromUnstruct ! !ARGUMENTS: character(len=*), intent(in) :: filename logical, intent(in), optional :: convertToDual type(ESMF_FileFormat_Flag), optional, intent(in) :: fileformat character(len=*), optional, intent(in) :: meshname logical, intent(in), optional :: addUserArea type(ESMF_MeshLoc), intent(in), optional :: maskFlag character(len=*), optional, intent(in) :: varname integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Create a mesh from a grid file defined in the ESMF Unstructured grid format. ! ! \begin{description} ! \item [filename] ! The name of the grid file ! \item[{[convertToDual]}] ! if {\tt .true.}, the mesh will be converted to its dual. If not specified, ! defaults to {\tt .false.}. ! \item[{[addUserArea]}] ! if {\tt .true.}, the cell area will be read in from the GRID file. This feature is ! only supported when the grid file is in the SCRIP or ESMF format. ! \item [{[fileformat]}] ! The type of grid file ! \item[{[meshname]}] ! The dummy variable for the mesh metadata in the UGRID file if the {\tt fileformat} ! is {\tt ESMF\_FILEFORMAT\_UGRID} ! \item[{[maskFlag]}] ! If present, generate the mask using the missing\_value attribute defined in 'varname' on ! the location defined by the flag, the accepted values are {\tt ESMF\_MESHLOC\_NODE} or ! {\tt ESMF\_MESHLOC\_ELEMENT} ! \item[{[varname]}] ! If maskFlag is present, 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 [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc ! local return code integer :: PetNo, PetCnt real(ESMF_KIND_R8),pointer :: nodeCoords(:,:), faceCoords(:,:) integer(ESMF_KIND_I4),pointer :: elementConn(:) integer(ESMF_KIND_I4),pointer :: elmtNum(:) integer :: startElmt integer :: NodeNo integer :: NodeCnt, total integer, allocatable :: NodeId(:) integer, allocatable :: NodeUsed(:) real(ESMF_KIND_R8), allocatable :: NodeCoords1D(:) real(ESMF_KIND_R8), allocatable :: NodeCoordsCart(:) real(ESMF_KIND_R8) :: coorX, coorY integer, allocatable :: NodeOwners(:) integer, allocatable :: NodeOwners1(:) integer, pointer :: glbNodeMask(:), NodeMask(:) integer :: ElemNo, TotalElements, startElemNo integer :: ElemCnt,i,j,k,dim, nedges integer :: localNodes, myStartElmt integer :: ConnNo, TotalConnects integer, allocatable :: ElemId(:) integer, allocatable :: ElemType(:) integer, allocatable :: ElemConn(:) integer, pointer :: elementMask(:), ElemMask(:) real(ESMF_KIND_R8), pointer :: elementArea(:), ElemArea(:) integer, allocatable :: LocalElmTable(:) integer :: sndBuf(1) type(ESMF_VM) :: vm type(ESMF_Mesh) :: Mesh integer :: numPoly #if 0 integer, parameter :: maxNumPoly=20 real(ESMF_KIND_R8) :: polyCoords(3*maxNumPoly) real(ESMF_KIND_R8) :: polyDblBuf(3*maxNumPoly) real(ESMF_KIND_R8) :: area(maxNumPoly) integer :: polyIntBuf(maxNumPoly) integer :: triInd(3*(maxNumPoly-2)) #else integer :: maxNumPoly real(ESMF_KIND_R8),allocatable :: polyCoords(:) real(ESMF_KIND_R8),allocatable :: polyDblBuf(:) real(ESMF_KIND_R8),allocatable :: area(:) integer,allocatable :: polyIntBuf(:) integer,allocatable :: triInd(:) #endif real(ESMF_KIND_R8) :: totalarea integer :: spatialDim integer :: parametricDim integer :: lni,ti,tk type(ESMF_FileFormat_Flag) :: fileformatlocal integer :: coordDim logical :: convertToDeg logical :: haveNodeMask, haveElmtMask logical :: haveMask logical :: localAddUserArea logical :: localConvertToDual type(ESMF_MeshLoc) :: localAddMask real(ESMF_KIND_R8), pointer :: varbuffer(:) real(ESMF_KIND_R8) :: missingvalue type(ESMF_CoordSys_Flag) :: coordSys integer :: maxEdges logical :: hasFaceCoords logical :: haveOrigGridDims integer :: origGridDims(2) integer :: poleVal, minPoleGid, maxPoleGid,poleObjType ! Initialize return code; assume failure until success is certain localrc = ESMF_RC_NOT_IMPL if (present(rc)) rc = ESMF_RC_NOT_IMPL ! set faceCoords to null faceCoords => NULL() hasFaceCoords = .false. if (present(addUserArea)) then localAddUserArea = addUserArea else localAddUserArea = .false. endif if (present(convertToDual)) then localConvertToDual = convertToDual else localConvertToDual = .false. endif if (present(maskFlag)) then localAddMask = maskFlag else localAddMask = ESMF_MESHLOC_NONE endif ! Read the mesh definition from the file if (present(fileformat)) then fileformatlocal = fileformat else fileformatlocal = ESMF_FILEFORMAT_ESMFMESH endif #if 0 if (fileformatlocal == ESMF_FILEFORMAT_UGRID) then if (.not. present(meshname)) then call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & msg="- meshname argument is missing", & ESMF_CONTEXT, rcToReturn=rc) endif endif #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 ! define default coordinate system coordSys = ESMF_COORDSYS_SPH_DEG ! define default haveOrigGridDims haveOrigGridDims=.false. ! Get grid info if (fileformatlocal == ESMF_FILEFORMAT_ESMFMESH) then ! Get coordDim call ESMF_EsmfInq(filename,coordDim=coordDim, haveNodeMask=haveNodeMask, & haveElmtMask=haveElmtMask, maxNodePElement=maxEdges, & haveOrigGridDims=haveOrigGridDims, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Don't convert if not 2D because that'll be cartesian right now if (coordDim .eq. 2) then convertToDeg = .true. else convertToDeg = .false. endif ! Get OrigGridDims if (haveOrigGridDims) then call ESMF_EsmfInq(filename, origGridDims=origGridDims, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Get information from file ! Need to return the coordinate system for the nodeCoords if (haveNodeMask) then call ESMF_EsmfGetNode(filename, nodeCoords, nodeMask=glbNodeMask,& convertToDeg=convertToDeg, coordSys=coordSys, rc=localrc) else call ESMF_EsmfGetNode(filename, nodeCoords, & convertToDeg=convertToDeg, coordSys=coordSys, rc=localrc) endif if (haveElmtMask .and. localAddUserArea) then call ESMF_EsmfGetElement(filename, elementConn, elmtNum, & startElmt, elementMask=elementMask, elementArea=elementArea, & centerCoords=faceCoords, & convertToDeg=convertToDeg, rc=localrc) elseif (haveElmtMask) then call ESMF_EsmfGetElement(filename, elementConn, elmtNum, & startElmt, elementMask=elementMask, & centerCoords=faceCoords, & convertToDeg=convertToDeg, rc=localrc) elseif (localAddUserArea) then call ESMF_EsmfGetElement(filename, elementConn, elmtNum, & startElmt, elementArea=elementArea, & centerCoords=faceCoords, & convertToDeg=convertToDeg, rc=localrc) else call ESMF_EsmfGetElement(filename, elementConn, elmtNum, startElmt, & centerCoords=faceCoords, & convertToDeg=convertToDeg, rc=localrc) endif ElemCnt = ubound (elmtNum, 1) totalConnects = ubound(elementConn, 1) if (associated(faceCoords)) then hasFaceCoords = .true. endif if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return elseif (fileformatlocal == ESMF_FILEFORMAT_UGRID) then haveElmtMask = .false. haveNodeMask = .false. if (localAddMask == ESMF_MESHLOC_ELEMENT) then haveElmtMask = .true. elseif (localAddMask == ESMF_MESHLOC_NODE) then haveNodeMask = .true. endif ! Get information from file call ESMF_GetMeshFromUGridFile(filename, nodeCoords, elementConn, & elmtNum, startElmt, convertToDeg=.true., & faceCoords=faceCoords, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Chenk if the grid is 3D or 2D coordDim = ubound(nodeCoords,1) nodeCnt = ubound(nodeCoords,2) ElemCnt = ubound (elmtNum, 1) totalConnects = ubound(elementConn, 1) if ( associated(faceCoords)) then hasFaceCoords = .true. endif if (coordDim == 2 .and. localAddMask == ESMF_MESHLOC_ELEMENT) then !Get the variable and the missing value attribute from file ! Total number of local elements allocate(varbuffer(ElemCnt)) call ESMF_UGridGetVarByName(filename, varname, varbuffer, startind=startElmt, & count=ElemCnt, location="face", & missingvalue=missingvalue, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Create local mask allocate(elementMask(ElemCnt)) elementMask(:)=1 do i=1,ElemCnt if (varbuffer(i) == missingvalue) elementMask(i)=0 enddo deallocate(varbuffer) elseif (coordDim == 2 .and. localAddMask == ESMF_MESHLOC_NODE) then !Get the variable and the missing value attribute from file ! Total number of total nodes allocate(varbuffer(nodeCnt)) call ESMF_UGridGetVarByName(filename, varname, varbuffer, & location="node", & missingvalue=missingvalue, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Create local mask allocate(glbNodeMask(nodeCnt)) glbNodeMask(:)=1 do i=1,nodeCnt if (varbuffer(i) == missingvalue) glbNodeMask(i)=0 enddo deallocate(varbuffer) endif else call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & msg="- unrecognized fileformat", & ESMF_CONTEXT, rcToReturn=rc) return endif nodeCnt = ubound(nodeCoords,2) ! Figure out dimensions if (coordDim .eq. 2) then parametricDim = 2 spatialDim = 2 else if (coordDim .eq. 3) then parametricDim = 3 spatialDim = 3 else call ESMF_LogSetError(ESMF_RC_VAL_OUTOFRANGE, & msg="- only coordDim 2 or 3 is supported right now", & ESMF_CONTEXT, rcToReturn=rc) return endif ! create the mesh Mesh = ESMF_MeshCreate3part (parametricDim, spatialDim, & coordSys=coordSys, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! These two arrays are temp arrays ! NodeUsed() used for multiple purposes, first, find the owners of the node ! later, used to store the local Node ID to be used in the ElmtConn table ! NodeOwners1() is the receiving array for ESMF_VMAllReduce(), it will store ! the lowest PET number that stores the node. That PET will become the owner ! of the node. allocate (NodeUsed(NodeCnt)) allocate (NodeOwners1(NodeCnt)) ! Set to a number > PetCnt because it will store the PetNo if this node is used by ! the local elements and we will do a global reduce to find the minimal values NodeUsed(:)=PetCnt+100 ! Set the coorsponding NodeUsed(:) value to my PetNo if it is used by the local element ! Also calculate the total number of mesh elements based on elmtNum totalElements = ElemCnt maxNumPoly=0 if (parametricDim .eq. 2) then j=1 do ElemNo = 1, ElemCnt do i=1,elmtNum(ElemNo) if (elementConn(j) /= ESMF_MESH_POLYBREAK) then NodeUsed(elementConn(j))=PetNo endif j=j+1 enddo if (elmtNum(ElemNo) > maxNumPoly) then maxNumPoly=elmtNum(ElemNo) endif end do else ! If not parametricDim==2, assuming parmetricDim==3 j=1 do ElemNo =1, ElemCnt do i=1,elmtNum(ElemNo) if (elementConn(j) /= ESMF_MESH_POLYBREAK) then NodeUsed(elementConn(j))=PetNo endif j=j+1 enddo end do endif if (totalConnects /= (j-1)) then print *, 'Total number of connection mismatch:', j, ElemCnt, totalConnects endif ! write(*,*) "maxNumPoly=",maxNumPoly ! Do a global reduce to find out the lowest PET No that owns each node, the result is in ! NodeOwners1(:) call ESMF_VMAllReduce(vm, NodeUsed, NodeOwners1, NodeCnt, ESMF_REDUCE_MIN, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! count number of nodes used and convert NodeUsed values into local index localNodes = 0 do NodeNo = 1, NodeCnt if (NodeUsed(NodeNo) == PetNo) then localNodes = localNodes+1 NodeUsed(NodeNo) = localNodes else NodeUsed(NodeNo) = 0 endif enddo ! allocate nodes arrays for ESMF_MeshAddNodes() allocate (NodeId(localNodes)) allocate (NodeOwners(localNodes)) if (parametricDim .eq. 2) then allocate (NodeCoords1D(localNodes*coordDim)) else ! If not parametricDim==2, assuming parmetricDim==3 allocate(NodeCoords1D(localNodes*3)) endif ! copy vertex information into nodes, NodeUsed(:) now contains either 0 (not for me) or ! the local node index. The owner of the node is stored in NodeOwners1(:) ! Also calculate how many nodes are "owned" by me -- total i = 1 total = 0 if (parametricDim .eq. 2) then do NodeNo = 1, NodeCnt if (NodeUsed(NodeNo) > 0) then NodeId(i) = NodeNo do dim = 1, coordDim NodeCoords1D ((i-1)*coordDim+dim) = nodeCoords (dim, NodeNo) end do NodeOwners (i) = NodeOwners1(NodeNo) if (NodeOwners1(NodeNo) == PetNo) total = total+1 i = i+1 endif end do else ! If not parametricDim==2, assuming parmetricDim==3 do NodeNo = 1, NodeCnt if (NodeUsed(NodeNo) > 0) then NodeId(i) = NodeNo do dim = 1, 3 NodeCoords1D ((i-1)*3+dim) = nodeCoords(dim, NodeNo) end do NodeOwners (i) = NodeOwners1(NodeNo) if (NodeOwners1(NodeNo) == PetNo) total = total+1 i = i+1 endif end do endif deallocate(nodeCoords) if (.not. haveNodeMask) then ! Add nodes call ESMF_MeshAddNodes (Mesh, NodeIds=NodeId, & NodeCoords=NodeCoords1D, & NodeOwners=NodeOwners, & rc=localrc) else allocate(NodeMask(localNodes)) do i=1,localNodes NodeMask(i)=glbNodeMask(NodeId(i)) enddo call ESMF_MeshAddNodes (Mesh, NodeIds=NodeId, & NodeCoords=NodeCoords1D, & NodeOwners=NodeOwners, & NodeMask = NodeMask, & rc=localrc) deallocate(NodeMask) deallocate(glbNodeMask) endif if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Need to calculate the total number of ESMF_MESH objects and the start element ID ! Do a global gather to get all the local TotalElements allocate(localElmTable(PetCnt)) sndBuf(1)=TotalElements call ESMF_VMAllGather(vm, sndBuf, localElmTable, 1, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Find out the start element ID myStartElmt=0 do i=1,PetNo myStartElmt = myStartElmt+localElmTable(i) end do deallocate(localElmTable) ! allocate element arrays for the local elements allocate (ElemId(TotalElements)) allocate (ElemType(TotalElements)) allocate (ElemConn(TotalConnects)) if (localAddUserArea) allocate(ElemArea(TotalElements)) ! Allocate mask if the user wants one haveMask=.false. if (haveElmtMask) then allocate (ElemMask(TotalElements)) haveMask=.true. endif ! The ElemId is the global ID. The myStartElmt is the starting Element ID(-1), and the ! element IDs will be from startElmt to startElmt+ElemCnt-1 ! The ElemConn() contains the four corner node IDs for each element and it is organized ! as a 1D array. The node IDs are "local", which are stored in NodeUsed(:) ElemNo = 1 ConnNo = 0 if (parametricDim .eq. 2) then ! Loop through creating Mesh appropriate elements k=1 do j = 1, ElemCnt if (elmtNum(j)==3) then ElemId(ElemNo) = myStartElmt+ElemNo ElemType (ElemNo) = ESMF_MESHELEMTYPE_TRI do i=1,3 if (elementConn(k) /= ESMF_MESH_POLYBREAK) then ElemConn (ConnNo+i) = NodeUsed(elementConn(k)) else ElemConn (ConnNo+i) = ESMF_MESH_POLYBREAK endif k=k+1 end do if (haveElmtMask) ElemMask(ElemNo) = elementMask(j) if (localAddUserArea) ElemArea(ElemNo) = elementArea(j) ElemNo=ElemNo+1 ConnNo=ConnNo+3 elseif (elmtNum(j)==4) then ElemId(ElemNo) = myStartElmt+ElemNo ElemType (ElemNo) = ESMF_MESHELEMTYPE_QUAD do i=1,4 if (elementConn(k) /= ESMF_MESH_POLYBREAK) then ElemConn (ConnNo+i) = NodeUsed(elementConn(k)) else ElemConn (ConnNo+i) = ESMF_MESH_POLYBREAK endif k=k+1 end do if (haveElmtMask) ElemMask(ElemNo) = elementMask(j) if (localAddUserArea) ElemArea(ElemNo) = elementArea(j) ElemNo=ElemNo+1 ConnNo=ConnNo+4 else ElemId(ElemNo) = myStartElmt+ElemNo ElemType (ElemNo) = elmtNum(j) do i=1,elmtNum(j) if (elementConn(k) /= ESMF_MESH_POLYBREAK) then ElemConn (ConnNo+i) = NodeUsed(elementConn(k)) else ElemConn (ConnNo+i) = ESMF_MESH_POLYBREAK endif k=k+1 end do if (haveElmtMask) ElemMask(ElemNo) = elementMask(j) if (localAddUserArea) ElemArea(ElemNo) = elementArea(j) ElemNo=ElemNo+1 ConnNo=ConnNo+elmtNum(j) endif enddo else ! If not parametricDim==2, assuming parmetricDim==3 k=1 do j = 1, ElemCnt if (elmtNum(j)==4) then ElemType (ElemNo) = ESMF_MESHELEMTYPE_TETRA elseif (elmtNum(j)==8) then ElemType (ElemNo) = ESMF_MESHELEMTYPE_HEX else call ESMF_LogSetError(ESMF_RC_VAL_OUTOFRANGE, & msg="- in 3D currently only support Tetra. (4 nodes) or Hexa. (8 nodes)", & ESMF_CONTEXT, rcToReturn=rc) return endif do i=1,elmtNum(j) if (elementConn(k) /= ESMF_MESH_POLYBREAK) then ElemConn (ConnNo+i) = NodeUsed(elementConn(k)) else ElemConn (ConnNo+i) = ESMF_MESH_POLYBREAK endif k=k+1 end do ElemId(ElemNo) = myStartElmt+ElemNo if (haveElmtMask) ElemMask(ElemNo) = elementMask(j) if (localAddUserArea) ElemArea(ElemNo) = elementArea(j) ElemNo=ElemNo+1 ConnNo=ConnNo+elmtNum(j) end do endif if ((ElemNo /= TotalElements+1) .or. (ConnNo /= TotalConnects)) then write (ESMF_UtilIOStdout,*) & PetNo, ' TotalElements does not match ',ElemNo-1, TotalElements, ConnNo, TotalConnects end if ! Add elements if (hasFaceCoords) then if (haveMask .and. localAddUserArea) then call ESMF_MeshAddElements (Mesh, ElemId, ElemType, ElemConn, & elementMask=ElemMask, elementArea=ElemArea, & elementCoords=reshape(faceCoords,(/totalElements*coordDim/)), rc=localrc) elseif (haveMask) then call ESMF_MeshAddElements (Mesh, ElemId, ElemType, ElemConn, & elementMask=ElemMask, & elementCoords=reshape(faceCoords,(/totalElements*coordDim/)), rc=localrc) elseif (localAddUserArea) then call ESMF_MeshAddElements (Mesh, ElemId, ElemType, ElemConn, & elementArea=ElemArea, & elementCoords=reshape(faceCoords,(/totalElements*coordDim/)), rc=localrc) else call ESMF_MeshAddElements (Mesh, ElemId, ElemType, ElemConn, & elementCoords=reshape(faceCoords,(/totalElements*coordDim/)), rc=localrc) end if else if (haveMask .and. localAddUserArea) then call ESMF_MeshAddElements (Mesh, ElemId, ElemType, ElemConn, & elementMask=ElemMask, elementArea=ElemArea, rc=localrc) elseif (haveMask) then call ESMF_MeshAddElements (Mesh, ElemId, ElemType, ElemConn, & elementMask=ElemMask, rc=localrc) elseif (localAddUserArea) then call ESMF_MeshAddElements (Mesh, ElemId, ElemType, ElemConn, & elementArea=ElemArea, rc=localrc) else call ESMF_MeshAddElements (Mesh, ElemId, ElemType, ElemConn, rc=localrc) end if endif if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Add pole info if applicable if ((fileformatlocal == ESMF_FILEFORMAT_ESMFMESH) .and. & haveOrigGridDims) then poleVal=4 poleObjType=1 ! Set elements minPoleGid=1 maxPoleGid=origGridDims(1) call C_ESMC_MeshSetPoles(Mesh, poleObjType, & poleVal, minPoleGid, maxPoleGid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return poleVal=5 poleObjType=1 ! Set elements minPoleGid=origGridDims(1)*origGridDims(2)-origGridDims(1)+1 maxPoleGid=origGridDims(1)*origGridDims(2) call C_ESMC_MeshSetPoles(Mesh, poleObjType, & poleVal, minPoleGid, maxPoleGid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif deallocate(NodeUsed, NodeId, NodeCoords1D, NodeOwners, NodeOwners1) deallocate(ElemId, ElemType, ElemConn, elementConn, elmtNum) if (haveElmtMask) deallocate(elementMask) if (haveMask) deallocate(ElemMask) if (associated(faceCoords)) deallocate(faceCoords) if (localAddUserArea) deallocate(elementArea, ElemArea) if (localConvertToDual) then ESMF_MeshCreateFromUnstruct = ESMF_MeshCreateDual(Mesh, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else ESMF_MeshCreateFromUnstruct = Mesh endif if (present(rc)) rc=ESMF_SUCCESS return end function ESMF_MeshCreateFromUnstruct !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshCreateFromScrip()" !BOPI ! !IROUTINE: ESMF_MeshCreateFrom Scrip - called from ESMF_MeshCreateFromFile ! Create a mesh from a unstructured grid defined in a SCRIP file ! ! !INTERFACE: ! Private name; call using ESMF_MeshCreate() function ESMF_MeshCreateFromScrip(filename, convertToDual, addUserArea, rc) ! ! ! !RETURN VALUE: type(ESMF_Mesh) :: ESMF_MeshCreateFromScrip ! !ARGUMENTS: character(len=*), intent(in) :: filename logical, intent(in), optional :: convertToDual logical, intent(in), optional :: addUSerArea integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Create a mesh from a grid file defined in SCRIP format or in ESMF Unstructured grid format. ! ! \begin{description} ! \item [filename] ! The name of the grid file ! \item[convertToDual] ! if {\tt .true.}, the mesh will be converted to it's dual. If not specified, ! defaults to .false. ! \item[addUserArea] ! if {\tt .true.}, the grid_area defined in the grid file will be added into the mesh. ! If not specified, defaults to .false. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc ! local return code character(len=128) :: cmd, esmffilename integer :: PetNo, PetCnt integer :: scrip_file_len, esmf_file_len type(ESMF_VM) :: vm integer :: dualflag integer :: unit logical :: notavail integer :: gridRank integer,pointer :: gridDims(:) integer :: poleVal, minPoleGid, maxPoleGid,poleObjType ! Initialize return code; assume failure until success is certain localrc = ESMF_RC_NOT_IMPL if (present(rc)) rc = ESMF_RC_NOT_IMPL ! Default convert to dual if (present(convertToDual)) then if (convertToDual) then dualflag=1 else dualflag=0 endif else dualflag=0 endif ! If convertToDual is TRUE, cannot use UserArea because the area defined ! in the grid file is not for the dual mesh if (present(addUserArea)) then if (addUserArea .and. dualflag==1) then call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg="- Cannot use user area when convertToDual flag is set to TRUE", & ESMF_CONTEXT, rcToReturn=rc) return endif 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 esmffilename = ".esmf.nc" if (PetNo == 0) then ! this is a serial call into C code for now call c_ConvertSCRIP(filename, esmffilename, & dualflag, localrc ) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif call ESMF_VMBarrier(vm) ESMF_MeshCreateFromScrip=ESMF_MeshCreateFromUnstruct(esmffilename,& addUserArea=addUserArea, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return if (PetNo == 0) then ! system() is not available on some of the compilers, use open/close to ! delete the file instead ! write(cmd, '("/bin/rm ",A)') trim(esmffilename) ! call system(cmd) ! First find an available unit numer call ESMF_UtilIOUnitGet(unit, rc=rc) if (rc==ESMF_SUCCESS) then open(unit, FILE=esmffilename,status='unknown') close(unit, STATUS='delete') endif endif ! Add pole information, if created from a 2D grid file allocate(gridDims(2)) call ESMF_ScripInq(filename, grid_rank=gridRank, grid_dims=gridDims, rc=localrc) if (ESMF_LogFoundError(localrc, & ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return if (gridRank==2) then ! Choose which object type to set based on whether this is a dual or not poleObjType=1 ! Set elems if (dualflag==1) poleObjType=0 ! Elems have been converted to nodes, so set nodes ! Set pole val to 4 poleVal=4 minPoleGid=1 maxPoleGid=gridDims(1) call C_ESMC_MeshSetPoles(ESMF_MeshCreateFromScrip, poleObjType, & poleVal, minPoleGid, maxPoleGid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set pole val to 5 poleVal=5 minPoleGid=gridDims(1)*gridDims(2)-gridDims(1)+1 maxPoleGid=gridDims(1)*gridDims(2) call C_ESMC_MeshSetPoles(ESMF_MeshCreateFromScrip, poleObjType, & poleVal, minPoleGid, maxPoleGid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif if (associated(gridDims)) deallocate(gridDims) ! Output success if (present(rc)) rc=ESMF_SUCCESS return end function ESMF_MeshCreateFromScrip !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshCreateFromPointer()" !BOPI ! !IROUTINE: ESMF_MeshCreate - Create a Mesh from a C++ pointer ! ! !INTERFACE: ! Private name; call using ESMF_MeshCreate() function ESMF_MeshCreateFromPointer(mesh_pointer, rc) ! ! ! !RETURN VALUE: type(ESMF_Mesh) :: ESMF_MeshCreateFromPointer ! !ARGUMENTS: type(ESMF_Pointer), intent(in) :: mesh_pointer integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Create an empty mesh. ! ! \begin{description} ! \item [parametricDim] ! Dimension of the topology of the Mesh. (E.g. a mesh constructed of squares would ! have a parametric dimension of 2, whereas a Mesh constructed of cubes would have one ! of 3.) ! \item[spatialDim] ! The number of coordinate dimensions needed to describe the locations of the nodes ! making up the Mesh. For a manifold, the spatial dimension can be larger than the ! parametric dim (e.g. the 2D surface of a sphere in 3D space), but it can't be smaller. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc integer :: numNode, numElem if(present(rc)) rc = ESMF_RC_NOT_IMPL ! initialize return code; assume routine not implemented ! Set pointer ESMF_MeshCreateFromPointer%this = mesh_pointer ! Check init status of arguments ESMF_INIT_SET_CREATED(ESMF_MeshCreateFromPointer) ! Create two distgrids, one for nodes and one for elements call C_ESMC_MeshCreateNodeDistGrid(ESMF_MeshCreateFromPointer, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call C_ESMC_MeshCreateElemDistGrid(ESMF_MeshCreateFromPointer, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set as fully created call C_ESMC_MeshSetStatus(ESMF_MeshCreateFromPointer, ESMF_MESHSTATUS_COMPLETE) if(present(rc)) rc = ESMF_SUCCESS end function ESMF_MeshCreateFromPointer !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshCreateFromIntPtr()" !!! BELOW ROUTINE EXPECTED TO GO AWAY WHEN MeshCap AND MeshCXX MERGED !!! !BOPI ! !IROUTINE: ESMF_MeshCreate - Create a Mesh from a internal C++ pointer ! ! !INTERFACE: function ESMF_MeshCreateFromIntPtr(mesh_pointer, rc) ! ! !RETURN VALUE: type(ESMF_Mesh) :: ESMF_MeshCreateFromIntPtr ! !ARGUMENTS: type(ESMF_Pointer), intent(in) :: mesh_pointer integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Create an empty mesh. ! ! \begin{description} ! \item [parametricDim] ! Dimension of the topology of the Mesh. (E.g. a mesh constructed of squares would ! have a parametric dimension of 2, whereas a Mesh constructed of cubes would have one ! of 3.) ! \item[spatialDim] ! The number of coordinate dimensions needed to describe the locations of the nodes ! making up the Mesh. For a manifold, the spatial dimension can be larger than the ! parametric dim (e.g. the 2D surface of a sphere in 3D space), but it can't be smaller. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc integer :: numNode, numElem if(present(rc)) rc = ESMF_RC_NOT_IMPL ! initialize return code; assume routine not implemented ! Create internal structure and Set pointer call C_ESMC_MeshCreateFromIntPtr(ESMF_MeshCreateFromIntPtr%this, & mesh_pointer, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Check init status of arguments ESMF_INIT_SET_CREATED(ESMF_MeshCreateFromIntPtr) ! Create two distgrids, one for nodes and one for elements call C_ESMC_MeshCreateNodeDistGrid(ESMF_MeshCreateFromIntPtr, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call C_ESMC_MeshCreateElemDistGrid(ESMF_MeshCreateFromIntPtr, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set as fully created call C_ESMC_MeshSetStatus(ESMF_MeshCreateFromIntPtr, ESMF_MESHSTATUS_COMPLETE) if(present(rc)) rc = ESMF_SUCCESS end function ESMF_MeshCreateFromIntPtr !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshGetIntPtr()" !BOPI ! !IROUTINE: ESMF_MeshGetIntPtr -- get internal pointer ! ! !INTERFACE: subroutine ESMF_MeshGetIntPtr(mesh, internalPtr, rc) ! ! !ARGUMENTS: type(ESMF_Mesh), intent(in) :: mesh type(ESMF_Pointer), intent(out) :: internalPtr integer, intent(out) , optional :: rc ! ! !DESCRIPTION: ! Get the internal pointer. ! ! \begin{description} ! \item [mesh] ! Mesh to get internal pointer from ! \item [internalPtr] ! Internal pointer ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc integer :: intMoabOn ! Init localrc localrc = ESMF_SUCCESS call c_esmc_meshgetinternalptr(mesh, internalPtr, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return if (present(rc)) rc = ESMF_SUCCESS end subroutine ESMF_MeshGetIntPtr !!!!!!!! private Mesh subroutines !!!!!!!!!! #undef ESMF_METHOD #define ESMF_METHOD "ESMF_DistGridGetNumIds()" subroutine ESMF_DistGridGetNumIds(distgrid, numIds, rc) type(ESMF_DistGrid), intent(in) :: distgrid integer, intent(out) :: numIds integer, intent(out), optional :: rc type(ESMF_DELayout) :: delayout integer :: localDeCount,lDE,numDEIDs integer :: localrc ! Get delayout from distgrid call ESMF_DistGridGet(distgrid, delayout=delayout, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Get local number of DEs call ESMF_DELayoutGet(delayout, localDECount=localDECount, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Iterate summing number of DEs numIds=0 do lDE=0,localDECount-1 call ESMF_DistGridGet(distgrid,localDe=lDE, & elementCount=numDEIds, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return numIds=numIds+numDEIds enddo end subroutine ESMF_DistGridGetNumIds #undef ESMF_METHOD #define ESMF_METHOD "ESMF_DistGridGetIds()" subroutine ESMF_DistGridGetIds(distgrid, Ids, rc) type(ESMF_DistGrid), intent(in) :: distgrid integer, intent(out) :: Ids(:) integer, intent(out), optional :: rc type(ESMF_DELayout) :: delayout integer :: localDeCount,lDE,numDEIDs integer :: startPos integer :: localrc ! Get delayout from distgrid call ESMF_DistGridGet(distgrid, delayout=delayout, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Get local number of DEs call ESMF_DELayoutGet(delayout, localDECount=localDECount, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Iterate summing number of DEs startPos=1 do lDE=0,localDECount-1 call ESMF_DistGridGet(distgrid,localDe=lDE, & elementCount=numDEIds, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return if (numDEIds >0) then call ESMF_DistGridGet(distgrid,localDe=lDE, & seqIndexList=Ids(startPos:startPos+numDEIds-1), rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif startPos=startPos+numDEIds enddo end subroutine ESMF_DistGridGetIds !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshCreateRedist()" !BOP ! !IROUTINE: ESMF_MeshCreate - Create a copy of a Mesh with a new distribution ! ! !INTERFACE: ! Private name; call using ESMF_MeshCreate() function ESMF_MeshCreateRedist(mesh, keywordEnforcer, nodalDistgrid, & elementDistgrid, vm, name, rc) ! ! ! !RETURN VALUE: type(ESMF_Mesh) :: ESMF_MeshCreateRedist ! !ARGUMENTS: type(ESMF_Mesh), intent(in) :: mesh type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below type(ESMF_DistGrid), intent(in), optional :: nodalDistgrid type(ESMF_DistGrid), intent(in), optional :: elementDistgrid type(ESMF_VM), intent(in), optional :: vm character(len=*), intent(in), optional :: name integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Create a copy of an existing Mesh with a new distribution. Information ! in the Mesh such as connections, coordinates, areas, masks, etc. are ! automatically redistributed to the new Mesh. To redistribute ! data in Fields built on the original Mesh create a Field on the new Mesh ! and then use the Field redistribution functionality ! ({\tt ESMF\_FieldRedistStore()}, etc.). The equivalent methods ! can also be used for data in FieldBundles. ! ! \begin{description} ! \item [mesh] ! The source Mesh to be redistributed. ! \item [{[nodalDistgrid]}] ! A Distgrid describing the new distribution of ! the nodes across the PETs. ! \item [{[elementDistgrid]}] ! A Distgrid describing the new distribution of ! the elements across the PETs. ! \item[{[vm]}] ! If present, the Mesh object is created on the specified ! {\tt ESMF\_VM} object. The default is to create on the VM of the ! current context. ! \item [{[name]}] ! The name of the Mesh. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOP !------------------------------------------------------------------------------ integer :: localrc type(ESMF_Logical) :: isfree type(ESMF_MeshStatus_Flag) :: status integer :: numNode, numElem integer :: numNodeIds, numElemIds integer, allocatable :: nodeIds(:), elemIds(:) type(ESMF_DELayout) :: delayout integer :: localDeCount type(ESMF_DistGrid) :: nodeDistGrid, elemDistGrid type(ESMF_VM) :: lvm integer :: localPet ! Init localrc localrc = ESMF_SUCCESS call ESMF_VMGetCurrent(lvm, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! set up local pet info call ESMF_VMGet(lvm, localPet=localPet, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Check input classes ESMF_INIT_CHECK_DEEP(ESMF_MeshGetInit, mesh, rc) ESMF_INIT_CHECK_DEEP(ESMF_DistGridGetInit, nodalDistgrid, rc) ESMF_INIT_CHECK_DEEP(ESMF_DistGridGetInit, elementDistgrid, rc) ! If mesh has not been fully created call C_ESMC_MeshGetStatus(mesh, status) if (status .ne. ESMF_MESHSTATUS_COMPLETE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh has not been fully created", & ESMF_CONTEXT, rcToReturn=rc) return endif !!! OPERATE BASED ON PRESENCE OF DISTGRIDS !!! if (present(nodalDistgrid)) then !! NODE AND ELEMENT DISTGRID BOTH PRESENT !! if (present(elementDistgrid)) then ! Get number of node Ids call ESMF_DistGridGetNumIds(nodalDistgrid, & numNodeIds, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Get number of element Ids call ESMF_DistGridGetNumIds(elementDistgrid, & numElemIds, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! If the C side doesn't exist, then don't need to redist, so exit call C_ESMC_MeshGetIsFree(mesh, isfree) if (isfree == ESMF_TRUE) then ESMF_INIT_SET_CREATED(ESMF_MeshCreateRedist) if (present(rc)) rc=ESMF_SUCCESS return endif ! Allocate space for node Ids allocate(nodeIds(numNodeIds)) ! Get node Ids call ESMF_DistGridGetIds(nodalDistgrid, & nodeIds, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Allocate space for element Ids allocate(elemIds(numElemIds)) ! Get element Ids call ESMF_DistGridGetIds(elementDistgrid,& elemIds, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Call into C call C_ESMC_MeshCreateRedist(mesh, & numNodeIds, nodeIds, & numElemIds, elemIds, & ESMF_MeshCreateRedist, & localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Deallocate gid arrays deallocate(nodeIds) deallocate(elemIds) call C_ESMC_MeshSetNodeDistGrid(ESMF_MeshCreateRedist, nodalDistgrid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call C_ESMC_MeshSetElemDistGrid(ESMF_MeshCreateRedist, elementDistgrid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else !! JUST NODE DISTGRID PRESENT !! call ESMF_DistGridGetNumIds(nodalDistgrid, numNodeIds, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! If the C side doesn't exist, then return an error ! because I don't know how to distribute nodes without elem info call C_ESMC_MeshGetIsFree(mesh, isfree) if (isfree == ESMF_TRUE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- method does not work if the input Mesh has no " // & "C Mesh attached and just the nodeDistgrid is specified", & ESMF_CONTEXT, rcToReturn=rc) return endif ! Allocate space for node Ids allocate(nodeIds(numNodeIds)) ! Get node Ids call ESMF_DistGridGetIds(nodalDistgrid, & nodeIds, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Call into C call C_ESMC_MeshCreateRedistNodes(mesh, & numNodeIds, nodeIds, & ESMF_MeshCreateRedist, & localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call C_ESMC_MeshSetNodeDistGrid(ESMF_MeshCreateRedist, nodalDistgrid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Deallocate gid arrays deallocate(nodeIds) ! Create elem distgrid call C_ESMC_MeshCreateElemDistGrid(ESMF_MeshCreateRedist, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif else !! JUST ELEMENT DISTGRID PRESENT !! if (present(elementDistgrid)) then call ESMF_DistGridGetNumIds(elementDistgrid, numElemIds, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! If the C side doesn't exist, then return an error ! because I don't know how to distribute nodes without elem info call C_ESMC_MeshGetIsFree(mesh, isfree) if (isfree == ESMF_TRUE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- method does not work if the input Mesh has no " // & "C Mesh attached and just the elemDistgrid is specified", & ESMF_CONTEXT, rcToReturn=rc) return endif ! Allocate space for element Ids allocate(elemIds(numElemIds)) ! Get element Ids call ESMF_DistGridGetIds(elementDistgrid, & elemIds, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Call into C call C_ESMC_MeshCreateRedistElems(mesh, & numElemIds, elemIds, & ESMF_MeshCreateRedist, & localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Deallocate gid arrays deallocate(elemIds) call C_ESMC_MeshSetElemDistGrid(ESMF_MeshCreateRedist, elementDistgrid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Create node distgrid and get number of nodes call C_ESMC_MeshCreateNodeDistGrid(ESMF_MeshCreateRedist, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else !! NO DISTGRIDs PRESENT -> make new mesh a copy of the old w/ new distgrids !! ! Need to get the distgrids first call c_ESMC_MeshGetNodeDistGrid(mesh, nodeDistGrid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set init code for deep C++ DistGrid object call ESMF_DistGridSetInitCreated(nodeDistGrid, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call c_ESMC_MeshGetElemDistGrid(mesh, elemDistGrid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set init code for deep C++ DistGrid object call ESMF_DistGridSetInitCreated(elemDistGrid, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Get number of node Ids call ESMF_DistGridGetNumIds(nodeDistGrid, numNodeIds, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Get number of element Ids call ESMF_DistGridGetNumIds(elemDistGrid, numElemIds, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! If the C side doesn't exist, then don't need to redist, so exit call C_ESMC_MeshGetIsFree(mesh, isfree) if (isfree == ESMF_TRUE) then ESMF_INIT_SET_CREATED(ESMF_MeshCreateRedist) if (present(rc)) rc=ESMF_SUCCESS return endif ! Allocate space for node Ids allocate(nodeIds(numNodeIds)) ! Get node Ids call ESMF_DistGridGetIds(nodeDistGrid, nodeIds, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Allocate space for element Ids allocate(elemIds(numElemIds)) ! Get element Ids call ESMF_DistGridGetIds(elemDistGrid, elemIds, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Call into C call C_ESMC_MeshCreateRedist(mesh, & numNodeIds, nodeIds, & numElemIds, elemIds, & ESMF_MeshCreateRedist, & localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Deallocate gid arrays deallocate(nodeIds) deallocate(elemIds) ! Create node distgrid and get number of nodes call C_ESMC_MeshCreateNodeDistGrid(ESMF_MeshCreateRedist, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Create elem distgrid and get number of elems call C_ESMC_MeshCreateElemDistGrid(ESMF_MeshCreateRedist, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif endif ! If vm is present, change new mesh to exist just on that VM if (present(vm)) then call C_ESMC_MeshFitOnVM(ESMF_MeshCreateRedist, & vm, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Set the name in Base object if (present(name)) then call c_ESMC_SetName(ESMF_MeshCreateRedist, "Mesh", name, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Set as created ESMF_INIT_SET_CREATED(ESMF_MeshCreateRedist) if (present(rc)) rc=ESMF_SUCCESS return end function ESMF_MeshCreateRedist !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshCreateDual()" !BOPI ! !IROUTINE: ESMF_MeshCreate - Create a dual of a mesh ! ! !INTERFACE: function ESMF_MeshCreateDual(mesh, rc) ! ! ! !RETURN VALUE: type(ESMF_Mesh) :: ESMF_MeshCreateDual ! !ARGUMENTS: type(ESMF_Mesh), intent(in) :: mesh integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Create the dual of an existing mesh. ! ! \begin{description} ! \item [mesh] ! The source Mesh. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc type(ESMF_MeshStatus_Flag) :: status integer :: numNode, numElem ! Init localrc localrc = ESMF_SUCCESS ! Check input classes ESMF_INIT_CHECK_DEEP(ESMF_MeshGetInit, mesh, rc) ! If mesh has not been fully created call C_ESMC_MeshGetStatus(mesh, status) if (status .ne. ESMF_MESHSTATUS_COMPLETE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh has not been fully created", & ESMF_CONTEXT, rcToReturn=rc) return endif ! Call into C call C_ESMC_MeshCreateDual(mesh, ESMF_MeshCreateDual, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! these should be set inside MeshCap ! Create node distgrid and get number of nodes call C_ESMC_MeshCreateNodeDistGrid(ESMF_MeshCreateDual, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call C_ESMC_MeshCreateElemDistGrid(ESMF_MeshCreateDual, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set as created ESMF_INIT_SET_CREATED(ESMF_MeshCreateDual) if (present(rc)) rc=ESMF_SUCCESS return end function ESMF_MeshCreateDual !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshCreateEasyElems1Type()" !BOP ! !IROUTINE: ESMF_MeshCreate - Create a Mesh of just one element type using corner coordinates ! ! !INTERFACE: ! Private name; call using ESMF_MeshCreate() function ESMF_MeshCreateEasyElems1Type(parametricDim, coordSys, & elementIds, elementType, elementCornerCoords, & elementMask, elementArea, elementCoords, & elementDistgrid, rc) ! ! ! !RETURN VALUE: type(ESMF_Mesh) :: ESMF_MeshCreateEasyElems1Type ! !ARGUMENTS: integer, intent(in) :: parametricDim type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys integer, intent(in), optional :: elementIds(:) integer, intent(in) :: elementType real(ESMF_KIND_R8), intent(in) :: elementCornerCoords(:,:,:) integer, intent(in), optional :: elementMask(:) real(ESMF_KIND_R8), intent(in), optional :: elementArea(:) real(ESMF_KIND_R8), intent(in), optional :: elementCoords(:,:) type(ESMF_DistGrid), intent(in), optional :: elementDistgrid integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Create a Mesh object in one step by just specifying the corner coordinates of each element. ! Internally these corners are turned into nodes forming the outside edges of the elements. ! This call assumes that each element is the same type to make the specification of the elements ! a bit easier. ! After this call the Mesh is usable, for ! example, a Field may be built on the created Mesh object and ! this Field may be used in {\tt ESMF\_FieldRegridStore()}. However, the Mesh created by this ! call consists of a set of disconnected elements, and so shouldn't be used in a situation where ! connections between elements are necessary (e.g. bilinear regridding on element centers, patch regridding, ! or second-order conservative regridding). ! ! This call sets the dimension of the elements in the Mesh ! via {\tt parametricDim} and the number of coordinate dimensions in the mesh ! is determined from the first dimension of {\tt elementCornerCoords}. ! ! The parameters to this call {\tt elementIds}, {\tt elementTypes}, and ! {\tt elementCornerCoords} describe the elements to be created. The description ! for a particular element lies at the same index location in {\tt elementIds} ! and {\tt elementTypes}. The argument {\tt elementCornerCoords} contains the coordinates of the ! corners used to create each element. The first dimension of this argument are across the coordinate dimensions. ! The second dimension of this argument is across the corners of a ! particular element. The last dimension of this argument is across the list ! of elements on this PET, so the coordinates of corner c in element e on this PET ! would be in {\tt elementCornerCoords(:,c,e)}. ! ! This call is {\em collective} across the current VM. ! ! \begin{description} ! \item [parametricDim] ! Dimension of the topology of the Mesh. (E.g. a mesh constructed of squares would ! have a parametric dimension of 2, whereas a Mesh constructed of cubes would have one ! of 3.) ! \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 [{[elementIds]}] ! An array containing the global ids of the elements to be created on this PET. ! This input consists of a 1D array the size of the number of elements on this PET. ! Each element id must be a number equal to or greater than 1. An id should be ! unique in the sense that different elements must have different ids (the same element ! that appears on different processors must have the same id). There may be gaps in the sequence ! of ids, but if these gaps are the same scale as the length of the sequence it can lead to ! inefficiencies when the Mesh is used (e.g. in {\tt ESMF\_FieldRegridStore()}). ! If not specified, then elements are numbered in sequence starting with the first element ! on PET 0. ! \item[elementType] ! An variable containing the type of the elements to be created in this Mesh. The type used ! must be appropriate for the parametric dimension of the Mesh. Please see ! Section~\ref{const:meshelemtype} for the list of options. ! \item[elementCornerCoords] ! A 3D array containing the coordinates of the corners of the elements ! to be created on this PET. The first dimension of this array is for the ! coordinates and should be of size 2 or 3. The size of this dimension will be ! used to determine the spatialDim of the Mesh. The second dimension is the number ! of corners for an element. The 3rd dimension is a list of all the elements on this PET. ! \item [{[elementMask]}] ! An array containing values which can be used for element masking. Which values indicate ! masking are chosen via the {\tt srcMaskValues} or {\tt dstMaskValues} arguments to ! {\tt ESMF\_FieldRegridStore()} call. This input consists of a 1D array the ! size of the number of elements on this PET. ! \item [{[elementArea]}] ! An array containing element areas. If not specified, the element areas are internally calculated. ! This input consists of a 1D array the size of the number of elements on this PET. ! {\bf NOTE:} ESMF doesn't currently do unit conversion on areas. If these areas are going to be used ! in a process that also involves the areas of another Grid or Mesh (e.g. conservative regridding), then ! it is the user's responsibility to make sure that the area units are consistent between the two sides. ! If ESMF calculates an area on the surface of a sphere, then it is in units of square radians. If ! it calculates the area for a Cartesian grid, then it is in the same units as the coordinates, but squared. ! \item[{[elementCoords]}] ! An array containing the physical coordinates of the elements to be created on this ! PET. This input consists of a 2D array with the first dimension that same size as the first dimension of {\tt elementCornerCoords}. ! The second dimension should be the same size as the {\tt elementTypes} argument. ! \item [{[elementDistgrid]}] ! If present, use this as the element Distgrid for the Mesh. ! The passed in Distgrid ! needs to contain a local set of sequence indices matching the set of local element ids (i.e. those in {\tt elementIds}). ! However, specifying an externally created Distgrid gives the user more control over aspects of ! the Distgrid containing those sequence indices (e.g. how they are broken into DEs). ! If not present, a 1D Distgrid will be created internally consisting of one DE per PET. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOP !------------------------------------------------------------------------------ integer :: localrc ! local return code integer :: num_elems, num_elemCorners,spatialDim integer, allocatable :: elementTypes(:) ! initialize return code; assume routine not implemented localrc = ESMF_RC_NOT_IMPL if (present(rc)) rc = ESMF_RC_NOT_IMPL ! This is just a simple wrapper function, so most error ! checking happens inside ESMF_MeshCreateEasyElems() ! Get number of spatial dimensions spatialDim=size(elementCornerCoords,1) num_elemCorners=size(elementCornerCoords,2) num_elems = size(elementCornerCoords,3) ! Create elem type array allocate(elementTypes(num_elems)) elementTypes=elementType ! Call into more general function ESMF_MeshCreateEasyElems1Type= & ESMF_MeshCreateEasyElemsGen(parametricDim, coordSys, & elementIds, elementTypes, & reshape(elementCornerCoords,(/spatialDim,num_elemCorners*num_elems/)), & elementMask, elementArea, elementCoords, & elementDistgrid, rc) ! deallocate array deallocate(elementTypes) end function ESMF_MeshCreateEasyElems1Type !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshCreateEasyElemsGen()" !BOP ! !IROUTINE: ESMF_MeshCreate - Create a Mesh using element corner coordinates ! ! !INTERFACE: ! Private name; call using ESMF_MeshCreate() function ESMF_MeshCreateEasyElemsGen(parametricDim, coordSys, & elementIds, elementTypes, elementCornerCoords, & elementMask, elementArea, elementCoords, & elementDistgrid, rc) ! ! ! !RETURN VALUE: type(ESMF_Mesh) :: ESMF_MeshCreateEasyElemsGen ! !ARGUMENTS: integer, intent(in) :: parametricDim type(ESMF_CoordSys_Flag), intent(in), optional :: coordSys integer, intent(in), optional :: elementIds(:) integer, intent(in) :: elementTypes(:) real(ESMF_KIND_R8), intent(in) :: elementCornerCoords(:,:) integer, intent(in), optional :: elementMask(:) real(ESMF_KIND_R8), intent(in), optional :: elementArea(:) real(ESMF_KIND_R8), intent(in), optional :: elementCoords(:,:) type(ESMF_DistGrid), intent(in), optional :: elementDistgrid integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Create a Mesh object in one step by just specifying the corner coordinates of each element. ! Internally these corners are turned into nodes forming the outside edges of the elements. ! After this call the Mesh is usable, for ! example, a Field may be built on the created Mesh object and ! this Field may be used in {\tt ESMF\_FieldRegridStore()}. However, the Mesh created by this ! call consists of a set of disconnected elements, and so shouldn't be used in a situation where ! connections between elements are necessary (e.g. bilinear regridding on element centers, patch regridding, ! or second-order conservative regridding). ! ! This call sets the dimension of the elements in the Mesh ! via {\tt parametricDim} and the number of coordinate dimensions in the mesh ! is determined from the first dimension of {\tt elementCornerCoords}. ! ! The parameters to this call {\tt elementIds}, {\tt elementTypes}, and ! {\tt elementCornerCoords} describe the elements to be created. The description ! for a particular element lies at the same index location in {\tt elementIds} ! and {\tt elementTypes}. The argument {\tt elementCornerCoords} consists of a list of ! all the corners used to create all the elements, so the corners for element $e$ in the ! {\tt elementTypes} array will start at $number\_of\_corners\_in\_element(1) ! + number\_of\_corners\_in\_element(2) + ! \cdots + number\_of\_corners\_in\_element(e-1) + 1$ in {\tt elementCornerCoords}. ! ! This call is {\em collective} across the current VM. ! ! \begin{description} ! \item [parametricDim] ! Dimension of the topology of the Mesh. (E.g. a mesh constructed of squares would ! have a parametric dimension of 2, whereas a Mesh constructed of cubes would have one ! of 3.) ! \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 [{[elementIds]}] ! An array containing the global ids of the elements to be created on this PET. ! This input consists of a 1D array the size of the number of elements on this PET. ! Each element id must be a number equal to or greater than 1. An id should be ! unique in the sense that different elements must have different ids (the same element ! that appears on different processors must have the same id). There may be gaps in the sequence ! of ids, but if these gaps are the same scale as the length of the sequence it can lead to ! inefficiencies when the Mesh is used (e.g. in {\tt ESMF\_FieldRegridStore()}). ! If not specified, then elements are numbered in sequence starting with the first element ! on PET 0. ! \item[elementTypes] ! An array containing the types of the elements to be created on this PET. The types used ! must be appropriate for the parametric dimension of the Mesh. Please see ! Section~\ref{const:meshelemtype} for the list of options. This input consists of ! a 1D array the size of the number of elements on this PET. ! \item[elementCornerCoords] ! A 2D array containing the coordinates of the corners of the elements ! to be created on this PET. The first dimension of this array is for the ! coordinates and should be of size 2 or 3. The size of this dimension will be ! used to determine the spatialDim of the Mesh. The second dimension is a collapsed ! list of all the corners in all the elements. The list of corners has been collapsed ! to 1D to enable elements with different number of corners to be supported in the ! same list without wasting space. ! The number of corners in each element is implied by its element type in ! {\tt elementTypes}. The corners for each element ! are in sequence in this array (e.g. If element 1 has 3 corners then they are in elementCornerCoords(:,1), ! elementCornerCoords(:,2), elementCornerCoords(:,3) and the corners for the next element start in elementCornerCoords(:,4)). ! \item [{[elementMask]}] ! An array containing values which can be used for element masking. Which values indicate ! masking are chosen via the {\tt srcMaskValues} or {\tt dstMaskValues} arguments to ! {\tt ESMF\_FieldRegridStore()} call. This input consists of a 1D array the ! size of the number of elements on this PET. ! \item [{[elementArea]}] ! An array containing element areas. If not specified, the element areas are internally calculated. ! This input consists of a 1D array the size of the number of elements on this PET. ! {\bf NOTE:} ESMF doesn't currently do unit conversion on areas. If these areas are going to be used ! in a process that also involves the areas of another Grid or Mesh (e.g. conservative regridding), then ! it is the user's responsibility to make sure that the area units are consistent between the two sides. ! If ESMF calculates an area on the surface of a sphere, then it is in units of square radians. If ! it calculates the area for a Cartesian grid, then it is in the same units as the coordinates, but squared. ! \item[{[elementCoords]}] ! An array containing the physical coordinates of the elements to be created on this ! PET. This input consists of a 2D array with the first dimension that same size as the first dimension of {\tt elementCornerCoords}. ! The second dimension should be the same size as the {\tt elementTypes} argument. ! \item [{[elementDistgrid]}] ! If present, use this as the element Distgrid for the Mesh. ! The passed in Distgrid ! needs to contain a local set of sequence indices matching the set of local element ids (i.e. those in {\tt elementIds}). ! However, specifying an externally created Distgrid gives the user more control over aspects of ! the Distgrid containing those sequence indices (e.g. how they are broken into DEs). ! If not present, a 1D Distgrid will be created internally consisting of one DE per PET. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOP !------------------------------------------------------------------------------ integer :: localrc integer :: numNode, numElem integer :: num_nodes integer :: num_elems, num_elemCorners type(ESMF_InterArray) :: elementMaskII type(ESMF_InterArray) :: elementIdsII real(ESMF_KIND_R8) :: tmpArea(2) integer :: areaPresent real(ESMF_KIND_R8) :: tmpCoords(2) integer :: coordsPresent type(ESMF_CoordSys_Flag) :: coordSysLocal integer :: spatialDim ! initialize return code; assume routine not implemented localrc = ESMF_RC_NOT_IMPL if (present(rc)) rc = ESMF_RC_NOT_IMPL ! Initialize pointer ESMF_MeshCreateEasyElemsGen%this = ESMF_NULL_POINTER ! Check init status of arguments ESMF_INIT_CHECK_DEEP(ESMF_DistgridGetInit, elementDistgrid, rc) ! Set Default coordSys if (present(coordSys)) then coordSysLocal=coordSys else coordSysLocal=ESMF_COORDSYS_SPH_DEG endif ! Get number of spatial dimensions spatialDim=size(elementCornerCoords,1) ! get size of lists num_elems = size(elementTypes) num_elemCorners = size(elementCornerCoords,2) ! If present make sure that elementCoords has the correct size if (present(elementCoords)) then if (size(elementCoords,1) .ne. & spatialDim) then call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & msg="- elementCoords input array is the wrong size.", & ESMF_CONTEXT, rcToReturn=rc) return endif endif ! Other array sizes are checked within C_ESMC_MeshCreateEasyElems() ! Create interface int to wrap optional element mask elementMaskII = ESMF_InterArrayCreate(elementMask, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Create interface int to wrap optional element ids elementIdsII = ESMF_InterArrayCreate(elementIds, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! set element area if it's present. if (present(elementCoords)) then if (present(elementArea)) then areaPresent=1 coordsPresent=1 call C_ESMC_MeshCreateEasyElems(ESMF_MeshCreateEasyElemsGen%this, & parametricDim, spatialDim, & num_elems, & elementIdsII, elementTypes, elementMaskII, & num_elemCorners,elementCornerCoords, & areaPresent, elementArea, & coordsPresent, elementCoords, & coordSysLocal, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else areaPresent=0 coordsPresent=1 call C_ESMC_MeshCreateEasyElems(ESMF_MeshCreateEasyElemsGen%this, & parametricDim, spatialDim, & num_elems, & elementIdsII, elementTypes, elementMaskII, & num_elemCorners,elementCornerCoords, & areaPresent, tmpArea, & coordsPresent, elementCoords, & coordSysLocal, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif else if (present(elementArea)) then areaPresent=1 coordsPresent=0 call C_ESMC_MeshCreateEasyElems(ESMF_MeshCreateEasyElemsGen%this, & parametricDim, spatialDim, & num_elems, & elementIdsII, elementTypes, elementMaskII, & num_elemCorners,elementCornerCoords, & areaPresent, elementArea, & coordsPresent, tmpCoords, & coordSysLocal, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else areaPresent=0 coordsPresent=0 call C_ESMC_MeshCreateEasyElems(ESMF_MeshCreateEasyElemsGen%this, & parametricDim, spatialDim, & num_elems, & elementIdsII, elementTypes, elementMaskII, & num_elemCorners,elementCornerCoords, & areaPresent, tmpArea, & coordsPresent, tmpCoords, & coordSysLocal, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif endif ! Create nodal distgrid call C_ESMC_MeshCreateNodeDistGrid(ESMF_MeshCreateEasyElemsGen, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Create a distgrid if it isn't passed in if (.not. present(elementDistgrid)) then call C_ESMC_MeshCreateElemDistGrid(ESMF_MeshCreateEasyElemsGen, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Get rid of interface Int wrappers call ESMF_InterArrayDestroy(elementMaskII, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterArrayDestroy(elementIdsII, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set as fully created call C_ESMC_MeshSetStatus(ESMF_MeshCreateEasyElemsGen, ESMF_MESHSTATUS_COMPLETE) ! Set init status of mesh ESMF_INIT_SET_CREATED(ESMF_MeshCreateEasyElemsGen) ! Set return code if (present (rc)) rc = localrc end function ESMF_MeshCreateEasyElemsGen !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshCreateCubedSphere()" !BOP ! !IROUTINE: ESMF_MeshCreateCubedSphere - Create a Mesh representation of a cubed sphere grid ! ! !INTERFACE: function ESMF_MeshCreateCubedSphere(tileSize, nx, ny, name, rc) ! !RETURN VALUE: type(ESMF_Mesh) :: ESMF_MeshCreateCubedSphere ! !ARGUMENTS: integer, intent(in) :: tileSize integer, intent(in) :: nx integer, intent(in) :: ny character(len=*), intent(in), optional :: name integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Create a {\tt ESMF\_Mesh} object for a cubed sphere grid using identical regular decomposition for every tile. ! The grid coordinates are generated based on the algorithm used by GEOS-5, The tile resolution is defined by ! {\tt tileSize}. Each tile is decomposed into nx x ny blocks and the total number of DEs used ! is nx x ny x 6. If the total PET is not equal to the number of DEs, the DEs are distributed ! into PETs in the default cyclic distribution. Internally, the nodes and the elements from multiple DEs are ! collapsed into a 1D array. Therefore, the nodal distgrid or the element distgrid attached to the Mesh object ! is always a one DE arbitrarily distributed distgrid. The sequential indices of the nodes and the elements ! are derived based on the location of the point in the Cubed Sphere grid. If an element is located at {\tt (x, y)} of ! tile {\tt n}. Its sequential index would be {\tt (n-1)*tileSize*tileSize+(y-1)*tileSize+x}. If it is a node, its ! sequential index would be {\tt (n-1)*(tileSize+1)*(tileSize+1)+(y-1)*(tileSize+1)+x}. ! ! The arguments are: ! \begin{description} ! \item[tilesize] ! The number of elements on each side of the tile of the Cubed Sphere grid ! \item[nx] ! The number of blocks on the horizontal size of each tile ! \item[ny] ! The number of blocks on the vertical size of each tile ! \item [{[name]}] ! The name of the Mesh. ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOP type(ESMF_Mesh) :: mesh type(ESMF_VM) :: vm integer :: PetNo, PetCnt integer, parameter :: f_p = selected_real_kind(15) ! double precision real(ESMF_KIND_R8), allocatable :: lonEdge(:,:), latEdge(:,:) real(ESMF_KIND_R8), allocatable :: lonEdge1D(:), latEdge1D(:) real(ESMF_KIND_R8), allocatable :: NodeCoords(:), CenterCoords(:) real(ESMF_KIND_R8), allocatable :: lonCenter(:,:), latCenter(:,:) integer, allocatable :: ElemIds(:), NodeIds(:) integer, allocatable :: ElemType(:) integer, allocatable :: ElemConn(:) integer, allocatable :: NodeOwners(:) integer :: sizei, sizej, starti, startj, tile integer :: rem, rem1, rem2, ind integer :: i, j, k, kk, kksave, l integer :: localNodes, localElems integer :: totalNodes integer, allocatable :: firstOwners(:), recvbuf(:), map(:) integer, allocatable :: origIds(:) integer :: maxDuplicate, uniquenodes integer :: localrc real(ESMF_KIND_R8) :: start_lat, end_lat, TOL real(ESMF_KIND_R8) :: starttime, endtime character(len=80) :: filename1 integer, allocatable :: start(:,:), count(:,:) integer, allocatable :: DElist(:), tileno(:) integer :: totalDE, localDE, unqlocalNodes integer, allocatable :: GlobalIDs(:), localIDs(:) ! 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 0 if (nx * ny * 6 /= PetCnt) then call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & msg="nx * ny does not equal to the total number of PETs", & ESMF_CONTEXT, rcToReturn=rc) return endif #endif allocate(lonEdge(tileSize+1, (tileSize+1)*6),latEdge(tileSize+1, (tileSize+1)*6)) ! Create a mesh mesh = ESMF_MeshCreate(2, 2, coordSys=ESMF_COORDSYS_SPH_DEG, name=name, rc=localrc) ! Distribute center coordinates according to the nx/ny decomposition #if 0 xsize = tileSize/nx ysize = tileSize/ny starty = ysize*(PetNo/nx)+1 startx = xsize*mod(PetNo,nx)+1 tile = (starty-1)/tilesize #endif ! use actual cubed sphere coordiantes totalDE = nx*ny*6 localNodes = 0 localElems = 0 if (PetCnt >= totalDE) then if (PetNo < totalDE) then localDE=1 else localDE=0 endif else ! multiple DEs per PET localDE=totalDE/PetCnt rem = mod(totalDE, PetCnt) if (PetNo < rem) localDE=localDE+1 endif if (localDE > 0) then allocate(DElist(localDE), tileno(localDE)) allocate(start(2,localDE), count(2,localDE)) ! deNo is zero-based do i=1,localDE DElist(i)=PetNo+PetCnt*(i-1) enddo do i=1,localDE tileno(i) = DElist(i)/(nx*ny)+1 rem = mod(DElist(i),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 *, PetNo, DElist(i), 'block:', starti, startj, sizei, sizej, tileno(i) start(1,i)=starti start(2,i)=startj count(1,i)=sizei count(2,i)=sizej localNodes = localNodes + (sizei+1)*(sizej+1) localElems = localElems + sizei*sizej enddo ! Add elements -- allocate arrays allocate(ElemIds(localElems), ElemConn(localElems*4), ElemType(localElems)) allocate(centerCoords(localElems*2)) ElemType = ESMF_MESHELEMTYPE_QUAD k=1 do i=1,localDE !call ESMF_VMWtime(starttime, rc=rc) ! Generate glocal edge coordinates and local center coordinates allocate(lonCenter(count(1,i), count(2,i)), latCenter(count(1,i), count(2,i))) if (i==1) then call ESMF_UtilCreateCSCoords(tileSize, lonEdge=lonEdge, latEdge=latEdge, & start=start(:,i), count=count(:,i), & tile=tileno(i), lonCenter=lonCenter, latCenter=latCenter) else call ESMF_UtilCreateCSCoords(tileSize, start=start(:,i), count=count(:,i), & tile=tileno(i), lonCenter=lonCenter, latCenter=latCenter) endif !call ESMF_VMWtime(endtime, rc=rc) lonCenter = lonCenter * ESMF_COORDSYS_RAD2DEG latCenter = latCenter * ESMF_COORDSYS_RAD2DEG do j=1,count(2,i) do l=1,count(1,i) ElemIds(k) = (tileno(i)-1)*tilesize*tilesize+(j+start(2,i)-2)*(tileSize)+start(1,i)+l-1 centerCoords(k*2-1) = lonCenter(l,j) centerCoords(k*2) = latCenter(l,j) k=k+1 enddo enddo deallocate(lonCenter, latCenter) enddo totalnodes = (tileSize+1)*(tileSize+1)*6 ! convert radius to degrees lonEdge = lonEdge * ESMF_COORDSYS_RAD2DEG latEdge = latEdge * ESMF_COORDSYS_RAD2DEG !Find unique set of node coordinates allocate(map(totalnodes)) TOL=0.0000000001 start_lat=-91.0 end_lat = 91.0 allocate(lonEdge1D(totalnodes), latEdge1D(totalnodes)) lonEdge1D = reshape(lonEdge, (/totalnodes/)) latEdge1D = reshape(latEdge, (/totalnodes/)) call c_ESMC_ClumpPntsLL(totalNodes, lonEdge1D, latEdge1D, & TOL, map, uniquenodes, & maxDuplicate, start_lat, end_lat, rc) deallocate(lonEdge1D, latEdge1D) ! Create a new array to point the new index back to the original index allocate(origIds(uniquenodes)) origIds(:)=0 do i=1,totalnodes k=map(i)+1 if (origIds(k)==0) origIds(k)=i enddo ! Find total unique local nodes in each PET allocate(firstowners(totalNodes), recvbuf(totalNodes)) ! Global ID for the elements and the nodes using its 2D index: (y-1)*tileSize+x ! for nodes shared by multiple PETs, the PET with smaller rank will own the ! nodes. k=1 firstOwners = PetCnt+1 !nodeOwners = PetNo allocate(GlobalIds(localNodes), localIds(localNodes)) do i=1,localDE do j=(tileno(i)-1)*(tileSize+1)+start(2,i),count(2,i)+start(2,i)+(tileno(i)-1)*(tileSize+1) do l=start(1,i),count(1,i)+start(1,i) !use the new index to the unique set of nodes kk = (j-1)*(tileSize+1)+l GlobalIds(k) = origIds(map(kk)+1) k=k+1 enddo enddo enddo ! Find if there are any duplicate globalIDs in the array ! First sort GlobalIds, return the original index in localIds and number of unique nodes call sort_int(GlobalIds, localIds, unqlocalnodes) allocate(NodeIds(unqlocalNodes), nodeCoords(unqlocalNodes*2), nodeOwners(unqlocalNodes)) do i=1,localnodes firstOwners(GlobalIds(i))=PetNo enddo ! global minimum of firstOwners to find the owner of the nodes (use the smallest PetNo) call ESMF_VMAllReduce(vm, firstOwners, recvbuf, totalNodes, & ESMF_REDUCE_MIN, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return do i=1,localNodes k=localIds(i) NodeIds(k)=GlobalIds(i) nodeOwners(k)=recvbuf(GlobalIds(i)) enddo k=1 kksave = 0 do i=1,localDE do j=(tileno(i)-1)*(tileSize+1)+start(2,i),count(2,i)+start(2,i)+(tileno(i)-1)*(tileSize+1) do l=start(1,i),count(1,i)+start(1,i) kk=localIds(k) if (kk > kksave) then nodeCoords(kk*2-1)=lonEdge(l, j) nodeCoords(kk*2)=latEdge(l,j) endif k=k+1 kksave = kk enddo enddo enddo deallocate(firstOwners, recvbuf, map, origIds) call ESMF_MeshAddNodes(mesh, NodeIds=NodeIds, & NodeCoords = NodeCoords, NodeOwners = NodeOwners, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return !deallocate(NodeIds, NodeCoords, NodeOwners) k=1 !local element index kk=1 !local node index do i=1,localDE do j=1,count(2,i) do l=1,count(1,i) ElemConn(k*4-3)=localIds(kk) ElemConn(k*4-2)=localIds(kk+1) ElemConn(k*4-1)=localIds(kk+1+(count(1,i)+1)) ElemConn(k*4)=localIds(kk+(count(1,i)+1)) k=k+1 kk=kk+1 enddo kk=kk+1 enddo kk=kk+count(1,i)+1 enddo call ESMF_MeshAddElements(mesh, ElemIds, ElemType, ElemConn, & elementCoords=centerCoords, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return deallocate(ElemIds, ElemConn, ElemType, centerCoords) else !localDE=0 !still have to call ESMF_MeshAddNodes() and ESMF_MeshAddElements() even if there is no DEs !First participate in ESMF_VMALlReduce() totalnodes = (tileSize+1)*(tileSize+1)*6 allocate(firstowners(totalnodes), recvbuf(totalnodes)) firstOwners = PetCnt+1 ! global minimum of firstOwners to find the owner of the nodes (use the smallest PetNo) call ESMF_VMAllReduce(vm, firstOwners, recvbuf, totalnodes, & ESMF_REDUCE_MIN, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return allocate(NodeIds(0), NodeCoords(0), NodeOwners(0)) call ESMF_MeshAddNodes(mesh, NodeIds=NodeIds, & NodeCoords = NodeCoords, NodeOwners = NodeOwners, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return allocate(ElemIds(0), ElemType(0), ElemConn(0)) allocate(centerCoords(0)) call ESMF_MeshAddElements(mesh, ElemIds, ElemType, ElemConn, & elementCoords=centerCoords, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return deallocate(firstowners, recvbuf) endif ! localDE>0 deallocate(lonEdge, latEdge) ESMF_MeshCreateCubedSphere = mesh ! Set return code if (present(rc)) rc=ESMF_SUCCESS end function ESMF_MeshCreateCubedSphere ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshDestroy" !BOP ! !IROUTINE: ESMF_MeshDestroy - Release resources associated with a Mesh ! ! !INTERFACE: subroutine ESMF_MeshDestroy(mesh, keywordEnforcer, noGarbage, rc) ! ! !RETURN VALUE: ! ! !ARGUMENTS: type(ESMF_Mesh), intent(inout) :: mesh 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[8.1.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: ! This call removes internal memory associated with {\tt mesh}. ! After this call {\tt mesh} will no longer be usable. ! ! The arguments are: ! \begin{description} ! \item [mesh] ! Mesh object 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 type(ESMF_Logical) :: isfree type(ESMF_MeshStatus_Flag) :: status type(ESMF_Logical) :: opt_noGarbage logical :: isCreated ESMF_INIT_CHECK_DEEP(ESMF_MeshGetInit, mesh, rc) ! Set default flags opt_noGarbage = ESMF_FALSE if (present(noGarbage)) opt_noGarbage = noGarbage #if 0 block character(80):: msg call C_ESMC_MeshGetIsFree(mesh, isfree) write(msg,*) "Entering ESMF_MeshDestroy with isfree=", isfree call ESMF_PointerLog(mesh%this, prefix=msg, logMsgFlag=ESMF_LOGMSG_DEBUG, rc=rc) end block #endif call C_ESMC_MeshGetIsFree(mesh, isfree) if (isfree == ESMF_FALSE) then ! This will also set the Base Status to INVALID call C_ESMC_MeshDestroy(mesh%this, opt_noGarbage, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else ! Even when there is no CMesh part, there is a Base, and it needs to ! be set to INVALID for correct garbage collection behavior call c_ESMC_BaseSetStatus(mesh, ESMF_STATUS_INVALID, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Mark as deleted ESMF_INIT_SET_DELETED(mesh) ! Set return code if (present(rc)) rc=ESMF_SUCCESS end subroutine ESMF_MeshDestroy !----------------------------------------------------------------------------- !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshEmptyCreate()" !BOP ! !IROUTINE: ESMF_MeshEmptyCreate - Create a Mesh to hold Distgrid information ! ! !INTERFACE: function ESMF_MeshEmptyCreate(nodalDistgrid, elementDistgrid, name, rc) ! ! ! !RETURN VALUE: type(ESMF_Mesh) :: ESMF_MeshEmptyCreate ! !ARGUMENTS: type(ESMF_DistGrid), intent(in), optional :: elementdistgrid type(ESMF_DistGrid), intent(in), optional :: nodalDistgrid character(len=*), intent(in), optional :: name integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Create a Mesh to hold distribution information (i.e. Distgrids). ! Such a mesh will have no coordinate or connectivity information stored. ! Aside from holding distgrids the Mesh created by this call can't be used in other ! ESMF functionality (e.g. it can't be used to create a Field or in regridding). ! ! \begin{description} ! \item [{[nodalDistgrid]}] ! The nodal distgrid. ! \item [{[elementDistgrid]}] ! The elemental distgrid. ! \item [{[name]}] ! The name of the Mesh. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOP !------------------------------------------------------------------------------ integer :: localrc ! ensure that Base is okay to be queried call c_ESMC_MeshCreateEmpty(ESMF_MeshEmptyCreate, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Mark that there isn't a C mesh underneath call C_ESMC_MeshSetIsFree(ESMF_MeshEmptyCreate) ! This is only a vehical for carrying distgrids, so it's not fully ! created yet. It should error out of most calls, except a specific set ! of MeshGet() queries. call C_ESMC_MeshSetStatus(ESMF_MeshEmptyCreate, ESMF_MESHSTATUS_EMPTY) if (present(nodalDistgrid)) then call C_ESMC_MeshSetNodeDistGrid(ESMF_MeshEmptyCreate, nodalDistgrid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif if (present(elementdistgrid)) then call C_ESMC_MeshSetElemDistGrid(ESMF_MeshEmptyCreate, elementdistgrid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Set the name in Base object if (present(name)) then call c_ESMC_SetName(ESMF_MeshEmptyCreate, "Mesh", name, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! mark as created ESMF_INIT_SET_CREATED(ESMF_MeshEmptyCreate) if (present(rc)) rc=ESMF_SUCCESS return end function ESMF_MeshEmptyCreate ! ----------------------------------------------------------------------------- #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshFreeMemory" !BOP ! !IROUTINE: ESMF_MeshFreeMemory - Remove a Mesh and its memory ! ! !INTERFACE: subroutine ESMF_MeshFreeMemory(mesh, rc) ! ! !RETURN VALUE: ! ! !ARGUMENTS: type(ESMF_Mesh), intent(inout) :: mesh integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! This call removes the portions of {\tt mesh} which contain connection and coordinate ! information. After this call, Fields build on {\tt mesh} will no longer be usable ! as part of an {\tt ESMF\_FieldRegridStore()} operation. However, after this call ! Fields built on {\tt mesh} can still be used in an {\tt ESMF\_FieldRegrid()} ! operation if the routehandle was generated beforehand. New Fields may also ! be built on {\tt mesh} after this call. ! ! The arguments are: ! \begin{description} ! \item [mesh] ! Mesh object whose memory is to be freed. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOP integer :: localrc type(ESMF_Logical) :: isfree ESMF_INIT_CHECK_DEEP(ESMF_MeshGetInit, mesh, rc) ! If already free, fine just return call C_ESMC_MeshGetIsFree(mesh, isfree) if (isfree == ESMF_TRUE) then if (present (rc)) rc = ESMF_SUCCESS return endif ! Free internal C++ mesh call C_ESMC_MeshFreeMemory(mesh,localrc) ! Set Freed status call C_ESMC_MeshSetIsFree(mesh) if (present (rc)) rc = localrc end subroutine ESMF_MeshFreeMemory !------------------------------------------------------------------------------ !----------------------------------------------------------------------------- #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshGet" !BOP ! !IROUTINE: ESMF_MeshGet - Get Mesh information ! ! !INTERFACE: subroutine ESMF_MeshGet(mesh, parametricDim, spatialDim, & nodeCount, nodeIds, nodeCoords, nodeOwners, & nodeMaskIsPresent, nodeMask,& elementCount, elementIds, elementTypes, & elementConnCount, elementConn, & elementMaskIsPresent,elementMask, & elementAreaIsPresent, elementArea, & elementCoordsIsPresent, elementCoords, & nodalDistgridIsPresent, nodalDistgrid, & elementDistgridIsPresent, elementDistgrid, & numOwnedNodes, ownedNodeCoords, & numOwnedElements, ownedElemCoords, & elemMaskArray, elemAreaArray, & isMemFreed, coordSys, status, name, rc) ! ! !RETURN VALUE: ! ! !ARGUMENTS: type(ESMF_Mesh), intent(in) :: mesh integer, intent(out), optional :: parametricDim integer, intent(out), optional :: spatialDim integer, intent(out), optional :: nodeCount integer, intent(out), optional :: nodeIds(:) real(ESMF_KIND_R8), intent(out), optional :: nodeCoords(:) integer, intent(out), optional :: nodeOwners(:) logical, intent(out), optional :: nodeMaskIsPresent integer, intent(out), optional :: nodeMask(:) integer, intent(out), optional :: elementCount integer, intent(out), optional :: elementIds(:) integer, intent(out), optional :: elementTypes(:) integer, intent(out), optional :: elementConnCount integer, intent(out), optional :: elementConn(:) logical, intent(out), optional :: elementMaskIsPresent integer, intent(out), optional :: elementMask(:) logical, intent(out), optional :: elementAreaIsPresent real(ESMF_KIND_R8), intent(out), optional :: elementArea(:) logical, intent(out), optional :: elementCoordsIsPresent real(ESMF_KIND_R8), intent(out), optional :: elementCoords(:) logical, intent(out), optional :: nodalDistgridIsPresent type(ESMF_DistGrid), intent(out), optional :: nodalDistgrid logical, intent(out), optional :: elementDistgridIsPresent type(ESMF_DistGrid), intent(out), optional :: elementDistgrid integer, intent(out), optional :: numOwnedNodes real(ESMF_KIND_R8), intent(out), optional :: ownedNodeCoords(:) integer, intent(out), optional :: numOwnedElements real(ESMF_KIND_R8), intent(out), optional :: ownedElemCoords(:) logical, intent(out), optional :: isMemFreed type(ESMF_Array), intent(inout), optional :: elemMaskArray type(ESMF_Array), intent(inout), optional :: elemAreaArray type(ESMF_CoordSys_Flag), intent(out), optional :: coordSys type(ESMF_MeshStatus_Flag),intent(out), optional :: status character(len=*), intent(out), optional :: name integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Get various information from a mesh. ! ! The arguments are: ! \begin{description} ! \item [mesh] ! Mesh object to retrieve information from. ! \item [{[parametricDim]}] ! Dimension of the topology of the Mesh. (E.g. a mesh constructed of squares would ! have a parametric dimension of 2, whereas a Mesh constructed of cubes would have one ! of 3.) ! \item[{[spatialDim]}] ! The number of coordinate dimensions needed to describe the locations of the nodes ! making up the Mesh. For a manifold, the spatial dimension can be larger than the ! parametric dim (e.g. the 2D surface of a sphere in 3D space), but it can't be smaller. ! \item [{[nodeCount]}] ! The number of local nodes in the mesh (both owned and shared with another PET). ! \item [{[nodeIds]}] ! An array of ids for each local node in the mesh. The nodeIds array should be of size nodeCount. ! \item [{[nodeCoords]}] ! An array of coordinates for each local node in the mesh. The nodeCoords array should be of size (spatialDim*nodeCount). ! \item [{[nodeOwners]}] ! An array of the PET numbers that own each local node in the mesh. The nodeOwners array should be of size nodeCount. ! \item [{[nodeMaskIsPresent]}] ! .true. if node masking was set in mesh, .false. otherwise. ! \item [{[nodeMask]}] ! An array of mask values for each local node in the mesh. The nodeOwners array should be of size nodeCount. ! \item [{[elementCount]}] ! The number of local elements in the mesh (both owned and shared with another PET). ! \item [{[elementIds]}] ! An array of ids for each local element in the mesh. The elementIds array should be of size elementCount. ! \item [{[elementTypes]}] ! An array of types for each local element in the mesh. Please see ! section~\ref{const:meshelemtype} for the list of options. The elementTypes array should be of size elementCount. ! \item [{[elementConnCount]}] ! The number of entries elementConn array. Provided as a convenience. ! \item[elementConn] ! An array containing the indexes of the sets of nodes to be connected together to form the ! elements to be created on this PET. The entries in this list are NOT node global ids, ! but rather each entry is a local index (1 based) into the list of nodes to be ! created on this PET by this call. ! In other words, an entry of 1 indicates that this element contains the node ! described by {\tt nodeIds(1)}, {\tt nodeCoords(1)}, etc. on this PET. It is also ! important to note that the order of the nodes in an element connectivity list ! matters. Please see Section~\ref{const:meshelemtype} for diagrams illustrating ! the correct order of nodes in a element. This input consists of a 1D array with ! a total size equal to the sum of the number of nodes contained in each element on ! this PET (also provided by elementConnCount). The number of nodes in each element ! is implied by its element type in ! {\tt elementTypes}. The nodes for each element ! are in sequence in this array (e.g. the nodes for element 1 are elementConn(1), ! elementConn(2), etc.). ! \item [{[elementMaskIsPresent]}] ! .true. if element masking was set in mesh, .false. otherwise. ! \item [{[elementMask]}] ! An array of mask values for each local element in the mesh. The elementMask array should be of size elementCount. ! \item [{[elementAreaIsPresent]}] ! .true. if element areas were set in mesh, .false. otherwise. ! \item [{[elementArea]}] ! An array of area values for each local element in the mesh. The elementArea array should be of size elementCount. ! \item [{[elementCoordsIsPresent]}] ! .true. if element coordinates were set in mesh, .false. otherwise. ! \item [{[elementCoords]}] ! An array of coordinate values for each local element in the mesh. The elementCoord array should be of size (spatialDim*elementCount). ! \item [{[nodalDistgridIsPresent]}] ! .true. if nodalDistgrid was set in Mesh object, .false. otherwise. ! \item [{[nodalDistgrid]}] ! A Distgrid describing the distribution of the nodes across the PETs. Note that ! on each PET the distgrid will only contain entries for nodes owned by that PET. ! This is the DistGrid that would be used to construct the Array in a Field that is constructed ! on {\tt mesh}. ! \item [{[elementDistgridIsPresent]}] ! .true. if elementDistgrid was set in Mesh object, .false. otherwise. ! \item [{[elementDistgrid]}] ! A Distgrid describing the distribution of elements across the PETs. Note that ! on each PET the distgrid will only contain entries for elements owned by that PET. ! \item [{[numOwnedNodes]}] ! The number of local nodes which are owned by this PET. This is the number of PET local entries in ! the nodalDistgrid. ! \item [{[ownedNodeCoords]}] ! The coordinates for the local nodes. These coordinates will be in the proper order to correspond ! with the nodes in the {\tt nodalDistgrid} returned by this call, and hence with a Field built on ! {\tt mesh}. The size of the input array should be the spatial dim of {\tt mesh} times ! {\tt numOwnedNodes}. ! \item [{[numOwnedElements]}] ! The number of local elements which are owned by this PET. Note that every element is owned by ! the PET it resides on, so unlike for nodes, {\tt numOwnedElements} is identical to the number of elements on ! the PET. It is also the number of PET local entries in the elementDistgrid. ! \item [{[ownedElemCoords]}] ! The center coordinates for the local elements. These coordinates will be in the proper order to correspond ! with the elements in the {\tt elementDistgrid} returned by this call, and hence with a Field built on the ! center of {\tt mesh}. The size of the input array should be the spatial dim of {\tt mesh} times ! {\tt numOwnedElements}. ! \item [{[elemMaskArray]}] ! The mask information for elements put into an ESMF Array. The ESMF Array must be build on a DistGrid which ! matches the elementDistgrid. ! \item [{[elemAreaArray]}] ! The area information for elements put into an ESMF Array. The ESMF Array must be build on a DistGrid which ! matches the elementDistgrid. ! \item [{[isMemFreed]}] ! Indicates if the coordinate and connection memory been freed from {\tt mesh}. If so, it ! can no longer be used as part of an {\tt ESMF\_FieldRegridStore()} call. ! \item[{[coordSys]}] ! The coordinate system of the grid coordinate data. ! \item[{[status]}] ! Flag indicating the status of the Mesh. Please ! see Section~\ref{const:meshstatus} for the list of options. ! \item [{[name]}] ! Name of the Mesh object. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOP integer :: localrc type(ESMF_Logical) :: isfree type(ESMF_MeshStatus_Flag) :: local_status integer :: sdim, pdim integer :: numNode, numElem type(ESMF_CoordSys_Flag) :: coordSysIn logical :: isPresent type(ESMF_Logical) :: isPresentAux integer, parameter :: maxElemArrays=2 integer :: numElemArrays type(ESMF_Pointer) :: elemArrays(maxElemArrays) integer :: infoTypeElemArrays(maxElemArrays) integer,parameter :: infoTypeElem_Mask=1 integer,parameter :: infoTypeElem_Area=2 type(ESMF_InterArray) :: elementIdsIA type(ESMF_InterArray) :: elementTypesIA type(ESMF_InterArray) :: elementConnIA type(ESMF_InterArray) :: elementMaskIA type(ESMF_InterArray) :: elementAreaIA type(ESMF_InterArray) :: elementCoordsIA type(ESMF_InterArray) :: nodeIdsIA type(ESMF_InterArray) :: nodeCoordsIA type(ESMF_InterArray) :: nodeOwnersIA type(ESMF_InterArray) :: nodeMaskIA integer :: nodeMaskIsPresentI integer :: elemMaskIsPresentI integer :: elemAreaIsPresentI integer :: elemCoordsIsPresentI type(ESMF_DistGrid) :: nodeDistGrid, elemDistGrid, elemDistGrid2 ! Init local rc localrc = ESMF_SUCCESS !!! Error check status of Mesh versus what's being asked for !!! ! Make sure mesh is initialized ESMF_INIT_CHECK_DEEP(ESMF_MeshGetInit, mesh, rc) ! If mesh has not been fully created, make sure that the user ! isn't asking for something that requires a fully created mesh call C_ESMC_MeshGetStatus(mesh, local_status) if (local_status .ne. ESMF_MESHSTATUS_COMPLETE) then ! Check one set of variables if (present(parametricDim) .or. & present(spatialDim) .or. & present(numOwnedNodes) .or. & present(ownedNodeCoords) .or. & present(numOwnedElements) .or. & present(ownedElemCoords) .or. & present(elemMaskArray) .or. & present(elemAreaArray) .or. & present(coordSys)) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh has not been fully created", & ESMF_CONTEXT, rcToReturn=rc) return endif ! Check another set, just so the length of the if isn't so big if (present(nodeCount) .or. & present(nodeIds) .or. & present(nodeCoords) .or. & present(nodeOwners) .or. & present(nodeMaskIsPresent) .or. & present(nodeMask)) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh has not been fully created", & ESMF_CONTEXT, rcToReturn=rc) return endif ! Check another set, just so the length of the if isn't so big if (present(elementCount) .or. & present(elementIds) .or. & present(elementTypes) .or. & present(elementConnCount) .or. & present(elementConn) .or. & present(elementMaskIsPresent) .or. & present(elementMask) .or. & present(elementAreaIsPresent) .or. & present(elementArea) .or. & present(elementCoordsIsPresent) .or. & present(elementCoords)) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh has not been fully created", & ESMF_CONTEXT, rcToReturn=rc) return endif endif ! XMRKX ! ! TODO: Rearrange all the info gets below to fit in to the 3 categories below !!!!!!!! Get Misc info from Mesh !!!!!!!! !!!!!!!! Get Node info from Mesh !!!!!!!! call C_ESMC_MeshGetDimensions(mesh, sdim, pdim, coordSysIn, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call C_ESMC_MeshGetOwnedNodeCount(mesh, numNode, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call C_ESMC_MeshGetOwnedElemCount(mesh, numElem, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Get parametric dim if (present(parametricDim)) parametricDim=pdim ! Get spatial dim if (present(spatialDim)) spatialDim=sdim ! Get number owned nodes if (present(numOwnedNodes)) numOwnedNodes = numNode ! Get number owned elements if (present(numOwnedElements)) numOwnedElements = numElem ! Get Node Count if (present(nodeCount)) then ! Make call to get info call C_ESMC_MeshGetNodeCount(mesh, & nodeCount, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Get information about whether various node information is present if (present(nodeMaskIsPresent)) then ! Init integer variables for getting logical info from C nodeMaskIsPresentI=0 ! Call into C call C_ESMC_MeshGetNodeInfoPresence(mesh, & nodeMaskIsPresentI, & localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set variables from C info if (present(nodeMaskIsPresent)) then nodeMaskIsPresent=.false. if (nodeMaskIsPresentI .ne. 0) nodeMaskIsPresent=.true. endif endif ! Get node creation info if (present(nodeIds) .or. & present(nodeCoords) .or. & present(nodeOwners) .or. & present(nodeMask)) then ! Create interface arrays nodeIdsIA = ESMF_InterArrayCreate(nodeIds, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return nodeCoordsIA = ESMF_InterArrayCreate(farray1DR8=nodeCoords, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return nodeOwnersIA = ESMF_InterArrayCreate(nodeOwners, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return nodeMaskIA = ESMF_InterArrayCreate(nodeMask, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Call into C call C_ESMC_MeshGetNodeCreateInfo(mesh, & nodeIdsIA, nodeCoordsIA, & nodeOwnersIA, nodeMaskIA, & localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Destroy interface arrays call ESMF_InterArrayDestroy(nodeIdsIA, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterArrayDestroy(nodeCoordsIA, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterArrayDestroy(nodeOwnersIA, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterArrayDestroy(nodeMaskIA, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif !!!!!!!! Get Elem info from Mesh !!!!!!!! ! Get Element Count if (present(elementCount)) then ! Make call to get info call C_ESMC_MeshGetElemCount(mesh, elementCount, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Get Element Connection Count if (present(elementConnCount)) then ! Make call to get info call C_ESMC_MeshGetElemConnCount(mesh, elementConnCount, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Get information about whether various elem information is present if (present(elementMaskIsPresent) .or. & present(elementAreaIsPresent) .or. & present(elementCoordsIsPresent)) then ! Init integer variables for getting logical info from C elemMaskIsPresentI=0 elemAreaIsPresentI=0 elemCoordsIsPresentI=0 ! Call into C call C_ESMC_MeshGetElemInfoPresence(mesh, & elemMaskIsPresentI, & elemAreaIsPresentI, & elemCoordsIsPresentI, & localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set variables from C info if (present(elementMaskIsPresent)) then elementMaskIsPresent=.false. if (elemMaskIsPresentI .ne. 0) elementMaskIsPresent=.true. endif if (present(elementAreaIsPresent)) then elementAreaIsPresent=.false. if (elemAreaIsPresentI .ne. 0) elementAreaIsPresent=.true. endif if (present(elementCoordsIsPresent)) then elementCoordsIsPresent=.false. if (elemCoordsIsPresentI .ne. 0) elementCoordsIsPresent=.true. endif endif ! Get elem creation info if (present(elementIds) .or. & present(elementTypes) .or. & present(elementConn) .or. & present(elementMask) .or. & present(elementArea) .or. & present(elementCoords)) then ! Create interface arrays elementIdsIA = ESMF_InterArrayCreate(elementIds, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return elementTypesIA = ESMF_InterArrayCreate(elementTypes, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return elementConnIA = ESMF_InterArrayCreate(elementConn, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return elementMaskIA = ESMF_InterArrayCreate(elementMask, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return elementAreaIA = ESMF_InterArrayCreate(farray1DR8=elementArea, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return elementCoordsIA = ESMF_InterArrayCreate(farray1DR8=elementCoords, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Call into C call C_ESMC_MeshGetElemCreateInfo(mesh, & elementIdsIA, elementTypesIA, & elementConnIA, elementMaskIA, & elementAreaIA, elementCoordsIA, & localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Destroy interface arrays call ESMF_InterArrayDestroy(elementIdsIA, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterArrayDestroy(elementTypesIA, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterArrayDestroy(elementConnIA, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterArrayDestroy(elementMaskIA, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterArrayDestroy(elementAreaIA, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterArrayDestroy(elementCoordsIA, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Get node coords if (present(ownedNodeCoords)) then call C_ESMC_MeshGetIsFree(mesh, isfree) if (isfree == ESMF_TRUE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh internals have been freed", & ESMF_CONTEXT, rcToReturn=rc) return endif ! Check array size if (size(ownedNodeCoords)<numNode*sdim) then call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & msg="- ownedNodeCoords too small to hold coordinates", & ESMF_CONTEXT, rcToReturn=rc) return endif ! Get coords from C call C_ESMC_GetLocalCoords(mesh, ownedNodeCoords, sdim, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif if (present(ownedElemCoords)) then call C_ESMC_MeshGetIsFree(mesh, isfree) if (isfree == ESMF_TRUE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh internals have been freed", & ESMF_CONTEXT, rcToReturn=rc) return endif ! Check array size if (size(ownedElemCoords)<numElem*sdim) then call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_WRONG, & msg="- ownedElemCoords too small to hold coordinates", & ESMF_CONTEXT, rcToReturn=rc) return endif ! Get coords from C call C_ESMC_GetLocalElemCoords(mesh, ownedElemCoords, sdim, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif isPresent = .false. ! Get nodal Distgrid presence if (present(nodalDistgridIsPresent)) then call c_ESMC_MeshGetNodeDistGridPresent(mesh, isPresentAux, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Output state nodalDistgridIsPresent=isPresentAux endif isPresent = .false. ! Get nodal Distgrid if (present(nodalDistgrid)) then call c_ESMC_MeshGetNodeDistGridPresent(mesh, isPresentAux, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return if (isPresentAux==ESMF_TRUE) then call c_ESMC_MeshGetNodeDistGrid(mesh, nodeDistGrid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set init code for deep C++ DistGrid object call ESMF_DistGridSetInitCreated(nodeDistGrid, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Output distgrid nodalDistgrid = nodeDistGrid else call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_NOT_CREATED, & msg="- this mesh doesn't contain a nodal distgrid", & ESMF_CONTEXT, rcToReturn=rc) return endif endif isPresent = .false. ! Get element Distgrid presence if (present(elementDistgridIsPresent)) then call c_ESMC_MeshGetElemDistGridPresent(mesh, isPresentAux, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Output state elementDistgridIsPresent=isPresentAux endif isPresent = .false. ! Get element Distgrid if (present(elementDistgrid)) then call c_ESMC_MeshGetElemDistGridPresent(mesh, isPresentAux, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return if (isPresentAux==ESMF_TRUE) then call c_ESMC_MeshGetElemDistGrid(mesh, elemDistGrid, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set init code for deep C++ DistGrid object call ESMF_DistGridSetInitCreated(elemDistGrid, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Output distgrid elementDistgrid = elemDistGrid else call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_NOT_CREATED, & msg="- this mesh doesn't contain an elemental distgrid", & ESMF_CONTEXT, rcToReturn=rc) return endif endif ! Init number of elem arrays for which user is asking numElemArrays=0 ! Get elem mask information if (present(elemMaskArray)) then ! Make sure mesh is initialized ESMF_INIT_CHECK_DEEP(ESMF_ArrayGetInit, elemMaskArray, rc) ! Set number of elem info request numElemArrays=numElemArrays+1 ! Load info type infoTypeElemArrays(numElemArrays)=infoTypeElem_Mask ! Load Array call ESMF_ArrayGetThis(elemMaskArray,elemArrays(numElemArrays),rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Get elem area information if (present(elemAreaArray)) then ! Make sure mesh is initialzed ESMF_INIT_CHECK_DEEP(ESMF_ArrayGetInit, elemAreaArray, rc) ! Set number of elem info request numElemArrays=numElemArrays+1 ! Load info type infoTypeElemArrays(numElemArrays)=infoTypeElem_Area ! Load Array call ESMF_ArrayGetThis(elemAreaArray,elemArrays(numElemArrays),rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Get mask or area info for elems if (numElemArrays .gt. 0) then call c_ESMC_MeshGetElemDistGrid(mesh, elemDistGrid2, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Make call to get info call C_ESMC_GetElemInfoIntoArray(mesh, & elemDistGrid2, & numElemArrays, & infoTypeElemArrays, & elemArrays, & localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Get freed status if (present(isMemFreed)) then call C_ESMC_MeshGetIsFree(mesh, isfree) isMemFreed=isfree endif ! Get coord system if (present(coordSys)) coordSys = coordSysIn ! Get status if (present(status)) status=local_status ! Special call to get name out of Base class if (present(name)) then call c_ESMC_GetName(mesh, name, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Error output if (present(rc)) rc = localrc end subroutine ESMF_MeshGet !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshGetMOAB()" !BOP ! !IROUTINE: ESMF_MeshGetMOAB -- Check on status of using MOAB library internally. ! ! !INTERFACE: subroutine ESMF_MeshGetMOAB(moabOn, rc) ! ! !ARGUMENTS: logical, intent(out) :: moabOn integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! This method is only temporary. It was created to enable testing during the stage in ESMF development while ! we have two internal mesh implementations. At some point it will be removed. ! ! This method can be used to check whether the MOAB library is being used ! to hold the internal structure of the Mesh. When set to .true. the following ! Mesh create calls create a Mesh using MOAB internally. When set to .false. the following ! Mesh create calls use the ESMF native internal mesh respresentation. Note that ESMF Meshes ! created on MOAB are only supported in a limited set of operations and should be used ! with caution as they haven't yet been tested as thoroughly as the native version. ! Also, operations that use a pair of Meshes (e.g. regrid weight generation) are only supported between ! meshes of the same type (e.g. you can regrid between two MOAB meshes, but not between a MOAB and ! a native mesh). ! ! \begin{description} ! \item [moabOn] ! Output variable which indicates current state of MOAB. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOP !------------------------------------------------------------------------------ integer :: localrc integer :: intMoabOn ! Init localrc localrc = ESMF_SUCCESS ! Get status from C call c_esmc_meshgetMOAB(intMoabOn, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Translate to logical moabOn=.false. if (intMoabOn .eq. 1) moabOn=.true. ! Return success if (present(rc)) rc = ESMF_SUCCESS end subroutine ESMF_MeshGetMOAB !----------------------------------------------------------------------------- ! -------------------------- ESMF-public method ------------------------------- #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshIsCreated()" !BOP ! !IROUTINE: ESMF_MeshIsCreated - Check whether a Mesh object has been created ! !INTERFACE: function ESMF_MeshIsCreated(mesh, keywordEnforcer, rc) ! !RETURN VALUE: logical :: ESMF_MeshIsCreated ! ! !ARGUMENTS: type(ESMF_Mesh), intent(in) :: mesh type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below integer, intent(out), optional :: rc ! !DESCRIPTION: ! Return {\tt .true.} if the {\tt mesh} 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[mesh] ! {\tt ESMF\_Mesh} queried. ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOP !----------------------------------------------------------------------------- ESMF_MeshIsCreated = .false. ! initialize if (present(rc)) rc = ESMF_SUCCESS if (ESMF_MeshGetInit(mesh)==ESMF_INIT_CREATED) & ESMF_MeshIsCreated = .true. end function !------------------------------------------------------------------------------ ! -------------------------- ESMF-public method ------------------------------- #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshMatch()" !BOPI ! !IROUTINE: ESMF_MeshMatch - Check if two Mesh objects match ! !INTERFACE: function ESMF_MeshMatch(mesh1, mesh2, rc) ! ! !RETURN VALUE: logical :: ESMF_MeshMatch ! !ARGUMENTS: type(ESMF_Mesh), intent(in) :: mesh1 type(ESMF_Mesh), intent(in) :: mesh2 integer, intent(out), optional :: rc ! ! ! !DESCRIPTION: ! Check if {\tt mesh1} and {\tt mesh2} match. Returns ! .true. if Mesh objects match, .false. otherwise. This ! method current just checks if mesh1 and mesh2s distgrids match, ! future work will do a more complex check. ! ! The arguments are: ! \begin{description} ! \item[mesh1] ! {\tt ESMF\_Mesh} object. ! \item[mesh2] ! {\tt ESMF\_Mesh} object. ! \item[{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: i, localrc type(ESMF_MeshStatus_Flag) :: status1, status2 integer :: mesh1sdim, mesh1pdim, mesh2sdim, mesh2pdim integer :: mesh1numNode, mesh1numElem, mesh2numNode, mesh2numElem type(ESMF_CoordSys_Flag) :: mesh1coordSys, mesh2coordSys type(ESMF_DistGridMatch_Flag) :: matchResultNode, matchResultElem type(ESMF_DistGrid) :: nodeDistGrid1, nodeDistGrid2, & elemDistGrid1, elemDistGrid2 real(ESMF_KIND_R8), pointer :: area1(:), area2(:) real(ESMF_KIND_R8), allocatable :: coord1(:), coord2(:) integer :: nOwnedNodes1, nOwnedElems1 integer :: nOwnedNodes2, nOwnedElems2 ! 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_MeshMatch = .false. ! Check init status of arguments ESMF_INIT_CHECK_DEEP(ESMF_MeshGetInit, mesh1, rc) ESMF_INIT_CHECK_DEEP(ESMF_MeshGetInit, mesh2, rc) ! If meshes have not been fully created call C_ESMC_MeshGetStatus(mesh1, status1) if (status1 .ne. ESMF_MESHSTATUS_COMPLETE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh has not been fully created", & ESMF_CONTEXT, rcToReturn=rc) return endif call C_ESMC_MeshGetStatus(mesh2, status2) if (status2 .ne. ESMF_MESHSTATUS_COMPLETE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh has not been fully created", & ESMF_CONTEXT, rcToReturn=rc) return endif call C_ESMC_MeshGetDimensions(mesh1, mesh1sdim, mesh1pdim, & mesh1coordSys, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call C_ESMC_MeshGetDimensions(mesh2, mesh2sdim, mesh2pdim, & mesh2coordSys, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call C_ESMC_MeshGetOwnedNodeCount(mesh1, mesh1numNode, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call C_ESMC_MeshGetOwnedElemCount(mesh1, mesh1numElem, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call C_ESMC_MeshGetOwnedNodeCount(mesh2, mesh2numNode, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call C_ESMC_MeshGetOwnedElemCount(mesh2, mesh2numElem, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call c_ESMC_MeshGetNodeDistGrid(mesh1, nodeDistGrid1, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set init code for deep C++ DistGrid object call ESMF_DistGridSetInitCreated(nodeDistGrid1, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call c_ESMC_MeshGetNodeDistGrid(mesh2, nodeDistGrid2, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set init code for deep C++ DistGrid object call ESMF_DistGridSetInitCreated(nodeDistGrid2, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call c_ESMC_MeshGetElemDistGrid(mesh1, elemDistGrid1, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set init code for deep C++ DistGrid object call ESMF_DistGridSetInitCreated(elemDistGrid1, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call c_ESMC_MeshGetElemDistGrid(mesh2, elemDistGrid2, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set init code for deep C++ DistGrid object call ESMF_DistGridSetInitCreated(elemDistGrid2, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! For now just make match to mean that the Mesh's have the same distgrids because that's ! all the fields care about matchResultNode=ESMF_DistGridMatch(nodeDistGrid1, nodeDistGrid2, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return matchResultElem=ESMF_DistGridMatch(elemDistGrid1, elemDistGrid2, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! return successfully if ((matchResultNode >= ESMF_DISTGRIDMATCH_EXACT) .and. & (matchResultElem >= ESMF_DISTGRIDMATCH_EXACT)) then ESMF_MeshMatch = .true. else ESMF_MeshMatch = .false. return endif ! check area allocate(area1(mesh1numElem), area2(mesh2numElem), stat=localrc) if (ESMF_LogFoundAllocError(localrc, & msg="- MeshMatch: Allocating area1 and area2 failed ", & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_MeshGetElemArea(mesh1, area1, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_MeshGetElemArea(mesh2, area2, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return do i = 1, mesh1numElem if(area1(i) /= area2(i)) then ESMF_MeshMatch = .false. deallocate(area1, area2) return endif enddo deallocate(area1, area2) #if 0 ! check nodal coordinates if(mesh1sdim /= mesh2sdim) then ESMF_MeshMatch = .false. return endif if(mesh1numNode /= mesh2numNode) then ESMF_MeshMatch = .false. return endif call ESMF_MeshGet(mesh1, numOwnedNodes=nOwnedNodes1, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_MeshGet(mesh2, numOwnedNodes=nOwnedNodes2, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return if(nOwnedNodes1 /= nOwnedNodes2) then ESMF_MeshMatch = .false. return endif allocate(coord1(nOwnedNodes1*mesh1sdim), & coord2(nOwnedNodes2*mesh2sdim), stat=localrc) if (ESMF_LogFoundAllocError(localrc, & msg="- MeshMatch: Allocating coord1 and coord2 failed ", & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_MeshGet(mesh1, ownedNodeCoords=coord1, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_MeshGet(mesh2, ownedNodeCoords=coord2, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return do i = 1, nOwnedNodes1 if(coord1(i) /= coord2(i)) then ESMF_MeshMatch = .false. deallocate(coord1, coord2) return endif enddo ! check element coordinates ! Currently mesh element coordinates are not required if(mesh1numElem /= mesh2numElem) then ESMF_MeshMatch = .false. return endif nCoord = mesh1numElem * mesh1sdim allocate(coord1(nCoord), coord2(mesh2numElem), stat=localrc) if (ESMF_LogFoundAllocError(localrc, & msg="- MeshMatch: Allocating coord1 and coord2 failed ", & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_MeshGet(mesh1, ownedElemCoords=coord1, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_MeshGet(mesh2, ownedElemCoords=coord2, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return do i = 1, mesh1numElem if(coord1(i) /= coord2(i)) then ESMF_MeshMatch = .false. deallocate(coord1, coord2) return endif enddo deallocate(coord1, coord2) #endif if (present(rc)) rc = ESMF_SUCCESS end function ESMF_MeshMatch !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshSerialize" !BOPI ! !IROUTINE: ESMF_MeshSerialize - Serialize mesh info into a byte stream ! ! !INTERFACE: subroutine ESMF_MeshSerialize(mesh, buffer, length, offset, & attreconflag, inquireflag, rc) ! ! !ARGUMENTS: type(ESMF_Mesh), intent(inout) :: mesh 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\_Mesh} 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 [mesh] ! {\tt ESMF\_Mesh} 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 :: i, localrc type(ESMF_Logical) :: isfree integer :: sdim, pdim type(ESMF_CoordSys_Flag) :: coordSys type(ESMF_AttReconcileFlag) :: lattreconflag type(ESMF_InquireFlag) :: linquireflag integer :: intFullyCreated logical :: isPresentNDG, isPresentEDG integer :: intIsPresentNDG, intIsPresentEDG ! Initialize localrc = ESMF_RC_NOT_IMPL if (present(rc)) rc = ESMF_RC_NOT_IMPL ! check variables ESMF_INIT_CHECK_DEEP(ESMF_MeshGetInit,mesh,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_MeshSerialize(mesh%this, 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_MeshSerialize !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshDeserialize" !BOPI ! !IROUTINE: ESMF_MeshDeserialize - Deserialize a byte stream into a Mesh ! ! !INTERFACE: function ESMF_MeshDeserialize(buffer, offset, attreconflag, rc) ! ! !RETURN VALUE: type(ESMF_Mesh) :: ESMF_MeshDeserialize ! ! !ARGUMENTS: character, pointer, dimension(:) :: buffer integer, intent(inout) :: offset type(ESMF_AttReconcileFlag), intent(in), optional :: attreconflag integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Takes a byte-stream buffer and reads the information needed to ! recreate a Mesh 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_Logical) :: isfree integer :: i type(ESMF_AttReconcileFlag) :: lattreconflag integer :: spatialDim, parametricDim integer :: intIsPresentNDG, intIsPresentEDG type(ESMF_CoordSys_Flag) :: coordSys ! 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 C_ESMC_MeshDeserialize(ESMF_MeshDeserialize%this, buffer, & offset, lattreconflag, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set init status ESMF_INIT_SET_CREATED(ESMF_MeshDeserialize) if (present(rc)) rc = ESMF_SUCCESS end function ESMF_MeshDeserialize ! ----------------------------------------------------------------------------- #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshSet" !BOP ! !IROUTINE: ESMF_MeshSet - Set some Mesh information ! ! !INTERFACE: subroutine ESMF_MeshSet(mesh, & elementMask, elementArea, rc) ! ! !RETURN VALUE: ! ! !ARGUMENTS: type(ESMF_Mesh), intent(in) :: mesh integer, intent(in), optional :: elementMask(:) real(ESMF_KIND_R8), intent(in), optional :: elementArea(:) integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! This call allows the user to change the set of information that it's legal to alter after ! a mesh has been created. Currently, this call requires that the information has already ! been added to the mesh during creation. For example, you can only change the element mask ! information, if the mesh was initially created with element masking. ! ! The arguments are: ! \begin{description} ! \item [mesh] ! \item [{[elementMask]}] ! An array of mask values for each local element in the mesh. The elementMask array should be of size elementCount. ! \item [{[elementArea]}] ! An array of area values for each local element in the mesh. The elementArea array should be of size elementCount. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOP integer :: localrc type(ESMF_MeshStatus_Flag) :: status type(ESMF_InterArray) :: elementMaskIA type(ESMF_InterArray) :: elementAreaIA ! Init local rc localrc = ESMF_SUCCESS !!! Error check status of Mesh versus what's being asked for !!! ! Make sure mesh is initialized ESMF_INIT_CHECK_DEEP(ESMF_MeshGetInit, mesh, rc) ! If mesh has not been fully created, make sure that the user ! isn't asking for something that requires a fully created mesh call C_ESMC_MeshGetStatus(mesh, status) if (status .ne. ESMF_MESHSTATUS_COMPLETE) then ! Check another set, just so the length of the if isn't so big if (present(elementMask) .or. & present(elementArea)) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh has not been fully created", & ESMF_CONTEXT, rcToReturn=rc) return endif endif ! XMRKX ! !!!!!!!! Set Misc info in Mesh !!!!!!!! !!!!!!!! Set Node info in Mesh !!!!!!!! !!!!!!!! Set Elem info in Mesh !!!!!!!! ! Set elem info if (present(elementMask) .or. & present(elementArea)) then ! Create interface arrays elementMaskIA = ESMF_InterArrayCreate(elementMask, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return elementAreaIA = ESMF_InterArrayCreate(farray1DR8=elementArea, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Call into C call C_ESMC_MeshSetElemInfo(mesh, & elementMaskIA, elementAreaIA, & localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Destroy interface arrays call ESMF_InterArrayDestroy(elementMaskIA, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterArrayDestroy(elementAreaIA, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return endif ! Error output if (present(rc)) rc = localrc end subroutine ESMF_MeshSet !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshSetMOAB()" !BOP ! !IROUTINE: ESMF_MeshSetMOAB -- Toggle using the MOAB library internally. ! ! !INTERFACE: subroutine ESMF_MeshSetMOAB(moabOn, rc) ! ! !ARGUMENTS: logical, intent(in) :: moabOn integer, intent(out) , optional :: rc ! ! !DESCRIPTION: ! This method is only temporary. It was created to enable testing during the stage in ESMF development while ! we have two internal mesh implementations. At some point it will be removed. ! ! This method can be employed to turn on or off using the MOAB library ! to hold the internal structure of the Mesh. When set to .true. the following ! Mesh create calls create a Mesh using MOAB internally. When set to .false. the following ! Mesh create calls use the ESMF native internal mesh respresentation. Note that ESMF Meshes ! created on MOAB are only supported in a limited set of operations and should be used ! with caution as they haven't yet been tested as thoroughly as the native version. ! Also, operations that use a pair of Meshes (e.g. regrid weight generation) are only supported between ! meshes of the same type (e.g. you can regrid between two MOAB meshes, but not between a MOAB and ! a native mesh). ! ! \begin{description} ! \item [moabOn] ! Variable used to turn MOAB on or off ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOP !------------------------------------------------------------------------------ integer :: localrc integer :: intMoabOn ! Init localrc localrc = ESMF_SUCCESS ! Translate to integer intMoabOn=0 if (moabOn) then intMoabOn=1 endif call c_esmc_meshsetMOAB(intMoabOn, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! add log messages about MOAB if (moabOn) then call ESMF_LogWrite ('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!', & ESMF_LOGMSG_INFO, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_LogWrite ('!!! MOAB turned ON !!!', & ESMF_LOGMSG_INFO, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_LogWrite ('!!! Meshes now created using MOAB !!!', & ESMF_LOGMSG_INFO, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_LogWrite ('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!', & ESMF_LOGMSG_INFO, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return else call ESMF_LogWrite ('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!', & ESMF_LOGMSG_INFO, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_LogWrite ('!!! MOAB turned OFF !!!', & ESMF_LOGMSG_INFO, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_LogWrite ('!!! Meshes now created using native !!!', & ESMF_LOGMSG_INFO, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_LogWrite ('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!', & ESMF_LOGMSG_INFO, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return end if if (present(rc)) rc = ESMF_SUCCESS end subroutine ESMF_MeshSetMOAB !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshWrite()" !BOPI ! !IROUTINE: ESMF_MeshWrite - Write a Mesh to a VTK file ! ! !INTERFACE: subroutine ESMF_MeshWrite(mesh, filename, rc) ! ! !ARGUMENTS: type(ESMF_Mesh), intent(in) :: mesh character (len=*), intent(in) :: filename integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Write a mesh to VTK file. ! ! \begin{description} ! \item [mesh] ! The mesh. ! \item[filename] ! The name of the output file. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc type(ESMF_Logical) :: isfree type(ESMF_MeshStatus_Flag) :: status ! 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_MeshGetInit, mesh, rc) call C_ESMC_MeshGetIsFree(mesh, isfree) if (isfree == ESMF_TRUE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh internals have been freed", & ESMF_CONTEXT, rcToReturn=rc) return endif call C_ESMC_MeshGetStatus(mesh, status) if (status .ne. ESMF_MESHSTATUS_COMPLETE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh has not been fully created", & ESMF_CONTEXT, rcToReturn=rc) return endif call C_ESMC_MeshWrite(mesh%this, filename, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return if (present(rc)) rc = localrc end subroutine ESMF_MeshWrite !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshWriteVTK()" !BOPI ! !IROUTINE: ESMF_MeshWriteVTK - Write a Mesh to a VTK file ! ! !INTERFACE: subroutine ESMF_MeshWriteVTK(mesh, filename, & nodeArray1, nodeArray2, nodeArray3, & elemArray1, elemArray2, elemArray3, & rc) ! ! !ARGUMENTS: type(ESMF_Mesh), intent(in) :: mesh character (len=*), intent(in) :: filename type(ESMF_Array), intent(in), optional :: nodeArray1 type(ESMF_Array), intent(in), optional :: nodeArray2 type(ESMF_Array), intent(in), optional :: nodeArray3 type(ESMF_Array), intent(in), optional :: elemArray1 type(ESMF_Array), intent(in), optional :: elemArray2 type(ESMF_Array), intent(in), optional :: elemArray3 integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Write a mesh to VTK file. ! ! \begin{description} ! \item [mesh] ! The mesh. ! \item[filename] ! The name of the output file. ! \item[{[nodeArray1-3]}] ! Arrays built on the node location of the mesh ! \item[{[elemArray1-3]}] ! Arrays built on the element location of the mesh ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc type(ESMF_Logical) :: isfree type(ESMF_MeshStatus_Flag) :: status ! 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_MeshGetInit, mesh, rc) call C_ESMC_MeshGetIsFree(mesh, isfree) if (isfree == ESMF_TRUE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh internals have been freed", & ESMF_CONTEXT, rcToReturn=rc) return endif call C_ESMC_MeshGetStatus(mesh, status) if (status .ne. ESMF_MESHSTATUS_COMPLETE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh has not been fully created", & ESMF_CONTEXT, rcToReturn=rc) return endif call C_ESMC_MeshWriteVTK(mesh%this, filename, & nodeArray1, nodeArray2, nodeArray3, & elemArray1, elemArray2, elemArray3, & localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return if (present(rc)) rc = localrc end subroutine ESMF_MeshWriteVTK !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshFindPnt()" !BOPI ! !IROUTINE: ESMF_MeshFindPnt - Find points in a mesh ! ! !INTERFACE: subroutine ESMF_MeshFindPnt(mesh, unmappedaction, & pntDim, pntCount, pntList, & petList, rc) ! ! !ARGUMENTS: type(ESMF_Mesh), intent(in) :: mesh type(ESMF_UnmappedAction_Flag), intent(in), optional :: unmappedaction integer, intent(in) :: pntDim integer, intent(in) :: pntCount real(ESMF_KIND_R8), pointer :: pntList(:) integer, pointer :: petList(:) integer, intent(out),optional :: rc ! ! !DESCRIPTION: ! Write a mesh to VTK file. ! ! \begin{description} ! \item [mesh] ! The mesh. ! \item [{[unmappedaction]}] ! Specifies what should happen if there are destination points that ! can't be mapped to a source cell. Options are ! {\tt ESMF\_UNMAPPEDACTION\_ERROR} or ! {\tt ESMF\_UNMAPPEDACTION\_IGNORE}. If not specified, defaults ! to {\tt ESMF\_UNMAPPEDACTION\_ERROR}. ! \item [pntDim] ! The dimension of the points in pntList. ! \item [pntNum] ! The number of points in pntList ! \item [petList] ! The generated list of pets for each point. ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc type(ESMF_Logical) :: isfree type(ESMF_MeshStatus_Flag) :: status type(ESMF_UnmappedAction_Flag) :: localunmappedaction ! 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_MeshGetInit, mesh, rc) call C_ESMC_MeshGetIsFree(mesh, isfree) if (isfree == ESMF_TRUE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh internals have been freed", & ESMF_CONTEXT, rcToReturn=rc) return endif call C_ESMC_MeshGetStatus(mesh, status) if (status .ne. ESMF_MESHSTATUS_COMPLETE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh has not been fully created", & ESMF_CONTEXT, rcToReturn=rc) return endif ! Set default vale for unmappedaction if (present(unmappedaction)) then localunmappedaction=unmappedaction else localunmappedaction=ESMF_UNMAPPEDACTION_ERROR endif ! Call into mesh find point subroutine ! TODO: ADD GIDS TO THIS INTERFACE AS THEY'RE AVAILABLE FROM C++ METHOD call C_ESMC_MeshFindPnt(mesh%this, localunmappedaction, pntDim, pntCount, & pntList, petList, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! return success if (present(rc)) rc = ESMF_SUCCESS end subroutine ESMF_MeshFindPnt !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshGetElemArea()" !BOPI ! !IROUTINE: ESMF_MeshGetElemArea - Find area of elements in mesh ! ! !INTERFACE: subroutine ESMF_MeshGetElemArea(mesh, areaList, rc) ! ! !ARGUMENTS: type(ESMF_Mesh), intent(in) :: mesh real(ESMF_KIND_R8), pointer :: areaList(:) integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Write a mesh to VTK file. ! ! \begin{description} ! \item [mesh] ! The mesh. ! \item [areaList] ! Areas for the mesh elements will be put here ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc type(ESMF_Logical) :: isfree type(ESMF_MeshStatus_Flag) :: status ! 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_MeshGetInit, mesh, rc) call C_ESMC_MeshGetIsFree(mesh, isfree) if (isfree == ESMF_TRUE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh internals have been freed", & ESMF_CONTEXT, rcToReturn=rc) return endif call C_ESMC_MeshGetStatus(mesh, status) if (status .ne. ESMF_MESHSTATUS_COMPLETE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh has not been fully created", & ESMF_CONTEXT, rcToReturn=rc) return endif ! Call into mesh get areas call C_ESMC_MeshGetArea(mesh%this, size(areaList), areaList, localrc); if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! return success if (present(rc)) rc = ESMF_SUCCESS end subroutine ESMF_MeshGetElemArea !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshGetElemFrac()" !BOPI ! !IROUTINE: ESMF_MeshGetElemFrac - Get frac of elements in mesh ! ! !INTERFACE: subroutine ESMF_MeshGetElemFrac(mesh, fracList, rc) ! ! !ARGUMENTS: type(ESMF_Mesh), intent(in) :: mesh real(ESMF_KIND_R8), pointer :: fracList(:) integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Write a mesh to VTK file. ! ! \begin{description} ! \item [mesh] ! The mesh. ! \item [fracList] ! Fractions for the mesh elements will be put here ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc type(ESMF_Logical) :: isfree type(ESMF_MeshStatus_Flag) :: status ! 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_MeshGetInit, mesh, rc) call C_ESMC_MeshGetIsFree(mesh, isfree) if (isfree == ESMF_TRUE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh internals have been freed", & ESMF_CONTEXT, rcToReturn=rc) return endif call C_ESMC_MeshGetStatus(mesh, status) if (status .ne. ESMF_MESHSTATUS_COMPLETE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh has not been fully created", & ESMF_CONTEXT, rcToReturn=rc) return endif ! Call into mesh get areas call C_ESMC_MeshGetFrac(mesh%this, size(fracList), fracList, localrc); if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! return success if (present(rc)) rc = ESMF_SUCCESS end subroutine ESMF_MeshGetElemFrac !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshGetElemFrac2()" !BOPI ! !IROUTINE: ESMF_MeshGetElemFrac2 - Get frac of elements in mesh ! ! !INTERFACE: subroutine ESMF_MeshGetElemFrac2(mesh, fracList, rc) ! ! !ARGUMENTS: type(ESMF_Mesh), intent(in) :: mesh real(ESMF_KIND_R8), pointer :: fracList(:) integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Write a mesh to VTK file. ! ! \begin{description} ! \item [mesh] ! The mesh. ! \item [fracList] ! Fractions for the mesh elements will be put here ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc type(ESMF_Logical) :: isfree type(ESMF_MeshStatus_Flag) :: status ! 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_MeshGetInit, mesh, rc) call C_ESMC_MeshGetIsFree(mesh, isfree) if (isfree == ESMF_TRUE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh internals have been freed", & ESMF_CONTEXT, rcToReturn=rc) return endif call C_ESMC_MeshGetStatus(mesh, status) if (status .ne. ESMF_MESHSTATUS_COMPLETE) then call ESMF_LogSetError(rcToCheck=ESMF_RC_OBJ_WRONG, & msg="- the mesh has not been fully created", & ESMF_CONTEXT, rcToReturn=rc) return endif ! Call into mesh get areas call C_ESMC_MeshGetFrac2(mesh%this, size(fracList), fracList, localrc); if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! return success if (present(rc)) rc = ESMF_SUCCESS end subroutine ESMF_MeshGetElemFrac2 !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshTurnOnCellMask()" !BOPI ! !IROUTINE: ESMF_MeshTurnOnCellMask -- Turn on masking to correspond to maskValues ! ! !INTERFACE: subroutine ESMF_MeshTurnOnCellMask(mesh, maskValues, rc) ! ! !ARGUMENTS: type(ESMF_Mesh), intent(in) :: mesh integer(ESMF_KIND_I4), optional :: maskValues(:) integer, intent(out) , optional :: rc ! ! !DESCRIPTION: ! Turn on mesh masking ! ! \begin{description} ! \item [mesh] ! The mesh to turn on masking for ! \item [maskValues] ! Values to set as masked ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc type(ESMF_InterArray) :: maskValuesArg ! Init localrc localrc = ESMF_SUCCESS ! If not present, then don't need to turn anything on if (.not. present(maskValues)) then if (present(rc)) rc = ESMF_SUCCESS return endif ! convert mask values maskValuesArg = ESMF_InterArrayCreate(maskValues, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call c_esmc_meshturnoncellmask(mesh, maskValuesArg, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterArrayDestroy(maskValuesArg, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return if (present(rc)) rc = ESMF_SUCCESS end subroutine ESMF_MeshTurnOnCellMask !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshTurnOffCellMask()" !BOPI ! !IROUTINE: ESMF_MeshTurnOffCellMask -- Turn off masking ! ! !INTERFACE: subroutine ESMF_MeshTurnOffCellMask(mesh, rc) ! ! !ARGUMENTS: type(ESMF_Mesh), intent(in) :: mesh integer, intent(out) , optional :: rc ! ! !DESCRIPTION: ! Turn on mesh masking ! ! \begin{description} ! \item [mesh] ! The mesh to turn on masking for ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc ! Init localrc localrc = ESMF_SUCCESS call c_esmc_meshturnoffcellmask(mesh, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return if (present(rc)) rc = ESMF_SUCCESS end subroutine ESMF_MeshTurnOffCellMask !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshTurnOnNodeMask()" !BOPI ! !IROUTINE: ESMF_MeshTurnOnNodeMask -- Turn on masking to correspond to maskValues ! ! !INTERFACE: subroutine ESMF_MeshTurnOnNodeMask(mesh, maskValues, rc) ! ! !ARGUMENTS: type(ESMF_Mesh), intent(in) :: mesh integer(ESMF_KIND_I4), optional :: maskValues(:) integer, intent(out) , optional :: rc ! ! !DESCRIPTION: ! Turn on mesh masking ! ! \begin{description} ! \item [mesh] ! The mesh to turn on masking for ! \item [maskValues] ! Values to set as masked ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc type(ESMF_InterArray) :: maskValuesArg ! Init localrc localrc = ESMF_SUCCESS ! If not present, then don't need to turn anything on if (.not. present(maskValues)) then if (present(rc)) rc = ESMF_SUCCESS return endif ! convert mask values maskValuesArg = ESMF_InterArrayCreate(maskValues, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call c_esmc_meshturnonnodemask(mesh, maskValuesArg, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_InterArrayDestroy(maskValuesArg, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return if (present(rc)) rc = ESMF_SUCCESS end subroutine ESMF_MeshTurnOnNodeMask !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshTurnOffNodeMask()" !BOPI ! !IROUTINE: ESMF_MeshTurnOffNodeMask -- Turn off masking ! ! !INTERFACE: subroutine ESMF_MeshTurnOffNodeMask(mesh, rc) ! ! !ARGUMENTS: type(ESMF_Mesh), intent(in) :: mesh integer, intent(out) , optional :: rc ! ! !DESCRIPTION: ! Turn on mesh masking ! ! \begin{description} ! \item [mesh] ! The mesh to turn on masking for ! \item [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc ! Init localrc localrc = ESMF_SUCCESS call c_esmc_meshturnoffnodemask(mesh, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return if (present(rc)) rc = ESMF_SUCCESS end subroutine ESMF_MeshTurnOffNodeMask !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshStatusEqual" !BOPI ! !IROUTINE: ESMF_MeshStatusEqual - Equality of MeshStatus statuses ! ! !INTERFACE: function ESMF_MeshStatusEqual(MeshStatus1, MeshStatus2) ! !RETURN VALUE: logical :: ESMF_MeshStatusEqual ! !ARGUMENTS: type (ESMF_MeshStatus_Flag), intent(in) :: & MeshStatus1, &! Two igrid statuses to compare for MeshStatus2 ! equality ! !DESCRIPTION: ! This routine compares two ESMF MeshStatus statuses to see if ! they are equivalent. ! ! The arguments are: ! \begin{description} ! \item[MeshStatus1, MeshStatus2] ! Two igrid statuses to compare for equality ! \end{description} ! !EOPI ESMF_MeshStatusEqual = (MeshStatus1%meshstatus == & MeshStatus2%meshstatus) end function ESMF_MeshStatusEqual !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshStatusNotEqual" !BOPI ! !IROUTINE: ESMF_MeshStatusNotEqual - Non-equality of MeshStatus statuses ! ! !INTERFACE: function ESMF_MeshStatusNotEqual(MeshStatus1, MeshStatus2) ! !RETURN VALUE: logical :: ESMF_MeshStatusNotEqual ! !ARGUMENTS: type (ESMF_MeshStatus_Flag), intent(in) :: & MeshStatus1, &! Two MeshStatus Statuses to compare for MeshStatus2 ! inequality ! !DESCRIPTION: ! This routine compares two ESMF MeshStatus statuses to see if ! they are unequal. ! ! The arguments are: ! \begin{description} ! \item[MeshStatus1, MeshStatus2] ! Two statuses of MeshStatuss to compare for inequality ! \end{description} ! !EOPI ESMF_MeshStatusNotEqual = (MeshStatus1%meshstatus /= & MeshStatus2%meshstatus) end function ESMF_MeshStatusNotEqual !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshLocEqual" !BOPI ! !IROUTINE: ESMF_MeshLocEqual - Equality of MeshLocs ! ! !INTERFACE: impure elemental function ESMF_MeshLocEqual(MeshLoc1, MeshLoc2) ! !RETURN VALUE: logical :: ESMF_MeshLocEqual ! !ARGUMENTS: type (ESMF_MeshLoc), intent(in) :: & MeshLoc1, &! Two igrid MeshLocs to compare for MeshLoc2 ! equality ! !DESCRIPTION: ! This routine compares two MeshLocs to see if ! they are equivalent. ! ! The arguments are: ! \begin{description} ! \item[MeshLoc1, MeshLoc2] ! Two igrid MeshLocs to compare for equality ! \end{description} ! !EOPI ESMF_MeshLocEqual = (MeshLoc1%meshloc == & MeshLoc2%meshloc) end function ESMF_MeshLocEqual !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshLocNotEqual" !BOPI ! !IROUTINE: ESMF_MeshLocNotEqual - Non-equality of MeshLocs ! ! !INTERFACE: function ESMF_MeshLocNotEqual(MeshLoc1, MeshLoc2) ! !RETURN VALUE: logical :: ESMF_MeshLocNotEqual ! !ARGUMENTS: type (ESMF_MeshLoc), intent(in) :: & MeshLoc1, &! Two MeshLocs to compare for MeshLoc2 ! inequality ! !DESCRIPTION: ! This routine compares two MeshLocs to see if ! they are unequal. ! ! The arguments are: ! \begin{description} ! \item[MeshLoc1, MeshLoc2] ! Two MeshLocs to compare for inequality ! \end{description} ! !EOPI ESMF_MeshLocNotEqual = (MeshLoc1%meshloc /= & MeshLoc2%meshloc) end function ESMF_MeshLocNotEqual ! -------------------------- ESMF-internal method ----------------------------- #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshGetInit" !BOPI ! !IROUTINE: ESMF_MeshGetInit - Internal access routine for init code ! ! !INTERFACE: function ESMF_MeshGetInit(mesh) ! ! !RETURN VALUE: ESMF_INIT_TYPE :: ESMF_MeshGetInit ! ! !ARGUMENTS: type(ESMF_Mesh), intent(in), optional :: mesh ! ! !DESCRIPTION: ! Access deep object init code. ! ! The arguments are: ! \begin{description} ! \item [mesh] ! Mesh object. ! \end{description} ! !EOPI if (present(mesh)) then ESMF_MeshGetInit = ESMF_INIT_GET(mesh) else ESMF_MeshGetInit = ESMF_INIT_CREATED endif end function ESMF_MeshGetInit !------------------------------------------------------------------------------ subroutine sort_int(origlist, newind, unique) ! ! !ARGUMENTS: integer(ESMF_KIND_I4), intent(in) :: origlist(:) integer(ESMF_KIND_I4), intent(inout) :: newind(:) integer(ESMF_KIND_I4), intent(out) :: unique INTEGER, PARAMETER :: SELECT = 20 ! .. ! .. Local Scalars .. INTEGER :: ENDD, I, J, START, STKPNT integer :: n , first, k integer(ESMF_KIND_I4) :: arrayel1, arrayel2, arrayel3, arrayel_minmax, arrayel_temp integer(ESMF_KIND_I4) :: indtemp, minind integer(ESMF_KIND_I4), allocatable :: list(:), origind(:), offset(:) ! .. ! .. Local Arrays .. INTEGER :: STACK( 2, 32 ) ! .. ! .. Executable Statements .. ! ! Test the input paramters. n = size (origlist) allocate(list(n), origind(n), offset(n)) list = origlist do i=1,n origind(i)=i newind(i)=i enddo STKPNT = 1 STACK( 1, 1 ) = 1 STACK( 2, 1 ) = N 10 CONTINUE START = STACK( 1, STKPNT ) ENDD = STACK( 2, STKPNT ) STKPNT = STKPNT - 1 IF( ENDD-START.LE.SELECT .AND. ENDD-START > 0 ) THEN ! ! Do Insertion sort on D( START:ENDD ) ! ! Sort into increasing order ! DO 50 I = START + 1, ENDD DO, J = I, START + 1, -1 IF( list( J ) < list( J-1 ) ) THEN arrayel_minmax = list( J ) list( J ) = list( J-1 ) list( J-1 ) = arrayel_minmax indtemp = origind(j) origind(j)=origind(j-1) origind(j-1)=indtemp ELSE GO TO 50 END IF end do 50 end do ! ELSE IF( ENDD-START > SELECT ) THEN ! ! Partition list( START:ENDD ) and stack parts, largest one first ! ! Choose partition entry as median of 3 ! arrayel1 = list( START ) arrayel2 = list( ENDD ) I = ( START+ENDD ) / 2 arrayel3 = list( I ) IF( arrayel1 < arrayel2 ) THEN IF( arrayel3 < arrayel1 ) THEN arrayel_minmax = arrayel1 ELSE IF( arrayel3 < arrayel2 ) THEN arrayel_minmax = arrayel3 ELSE arrayel_minmax = arrayel2 END IF ELSE IF( arrayel3 < arrayel2 ) THEN arrayel_minmax = arrayel2 ELSE IF( arrayel3 < arrayel1 ) THEN arrayel_minmax = arrayel3 ELSE arrayel_minmax = arrayel1 END IF END IF ! I = START - 1 J = ENDD + 1 90 CONTINUE do J = J - 1 IF( list( J ) <= arrayel_minmax )& & exit end do do I = I + 1 IF( list( I ) >= arrayel_minmax )& & exit end do IF( I < J ) THEN arrayel_temp = list( I ) list( I ) = list( J ) list( J ) = arrayel_temp indtemp = origind(i) origind(i)=origind(j) origind(j)=indtemp GO TO 90 END IF IF( J-START > ENDD-J-1 ) THEN STKPNT = STKPNT + 1 STACK( 1, STKPNT ) = START STACK( 2, STKPNT ) = J STKPNT = STKPNT + 1 STACK( 1, STKPNT ) = J + 1 STACK( 2, STKPNT ) = ENDD ELSE STKPNT = STKPNT + 1 STACK( 1, STKPNT ) = J + 1 STACK( 2, STKPNT ) = ENDD STKPNT = STKPNT + 1 STACK( 1, STKPNT ) = START STACK( 2, STKPNT ) = J END IF END IF IF( STKPNT > 0 ) & & GO TO 10 ! find unique elements in list offset = 0 unique=1 first=-1 do i=2,n if (list(i) > list(i-1)) then unique=unique+1 if (first>0) then !found duplicate, set the newIds to the smallest of the list minind = origind(first) do j=first+1,i-1 if (origind(j)<minind) minind=origind(j) enddo do j=first,i-1 if (origind(j) > minind) then do k=origind(j)+1,n offset(k)=offset(k)+1 enddo endif newind(origind(j))=minind enddo first=-1 endif else if (first<0) first=i-1 endif enddo do i=1,n newind(i)=newind(i)-offset(newind(i)) enddo RETURN end subroutine sort_int #if 0 !------------------------------------------------------------------------------ !--- In this function, the node coordinates of the mesh are read in to multiple PETs in !--- parallel and redistributed to its resident nodes based on the cell partition. !--- The other version of the same function reads the entire node coordinates into every !--- PET and only store the ones the local cells use. This version may same some memory !--- space if the number of nodes in the mesh is huge. But it creates more communication !--- and handshaking thus will run slower in most of the cases. !------------------------------------------------------------------------------ #undef ESMF_METHOD #define ESMF_METHOD "ESMF_MeshCreateFromUnstruct()" !BOPI ! !IROUTINE: ESMF_MeshCreate - Create a Mesh from a grid file defined in the ESMF Unstructured ! Grid format -- this is the parallel version and it only works for UGRID. ! Keep the code here but commented it out for 6.3.0 release ! Create a triangle and quad mesh using a global node coordinate table and a distributed ! element connection array ! arguments: VertexCoords(3, NodeCnt), where NodeCnt is the total node count for the ! global mesh, the first dimension stores the x,y,z coordinates of the node ! CellConnect(4, ElemCnt), where ElemCnt is the total number of elements ! The first dimension contains the global node IDs at the four corner of the element ! StartCell, the first Element ID in this PET ! in this local PET. Note the CellConnect is local and VertexCoords is global. ! In this routine, we have to figure out which nodes are used by the local Elements ! and who are the owners of the local nodes, then add the local nodes and elements into ! the mesh ! !INTERFACE: ! Private name; call using ESMF_MeshCreate() function ESMF_MeshCreateFromUnstruct(filename, fileformat, & addUserArea, maskFlag, varname, rc) ! ! ! !RETURN VALUE: type(ESMF_Mesh) :: ESMF_MeshCreateFromUnstruct ! !ARGUMENTS: character(len=*), intent(in) :: filename type(ESMF_FileFormat_Flag), optional, intent(in) :: fileformat logical, intent(in), optional :: addUserArea type(ESMF_MeshLoc), intent(in), optional :: maskFlag character(len=*), optional, intent(in) :: varname integer, intent(out), optional :: rc ! ! !DESCRIPTION: ! Create a mesh from a grid file defined in the ESMF Unstructured grid format. ! ! \begin{description} ! \item [filename] ! The name of the grid file ! \item[{[addUserArea]}] ! if {\tt .true.}, the cell area will be read in from the GRID file. This feature is ! only supported when the grid file is in the SCRIP or ESMF format. ! \item [{[fileformat]}] ! The type of grid file ! \item[{[meshname]}] ! The dummy variable for the mesh metadata in the UGRID file if the {\tt fileformat} ! is {\tt ESMF\_FILEFORMAT\_UGRID} ! \item[{[maskFlag]}] ! If present, generate the mask using the missing\_value attribute defined in 'varname' on ! the location defined by the flag, the accepted values are {\tt ESMF\_MESHLOC\_NODE} or ! {\tt ESMF\_MESHLOC\_ELEMENT} ! \item[{[varname]}] ! If maskFlag is present, 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 [{[rc]}] ! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors. ! \end{description} ! !EOPI !------------------------------------------------------------------------------ integer :: localrc ! local return code integer :: PetNo, PetCnt real(ESMF_KIND_R8),pointer :: nodeCoords(:,:) integer(ESMF_KIND_I4),pointer :: elementConn(:,:) integer(ESMF_KIND_I4),pointer :: elmtNum(:) integer :: startElmt integer :: NodeNo integer :: NodeCnt, total integer, allocatable :: NodeId(:) integer, allocatable :: NodeUsed(:) real(ESMF_KIND_R8), allocatable :: NodeCoords1D(:) real(ESMF_KIND_R8), allocatable :: NodeCoordsCart(:) real(ESMF_KIND_R8) :: coorX, coorY integer, allocatable :: NodeOwners(:) integer, allocatable :: NodeOwners1(:) integer, pointer :: glbNodeMask(:), NodeMask(:) integer :: ElemNo, TotalElements, startElemNo integer :: ElemCnt,i,j,k,n,dim, nedges integer :: localNodes, myStartElmt integer :: ConnNo, TotalConnects integer, allocatable :: ElemId(:) integer, allocatable :: ElemType(:) integer, allocatable :: ElemConn(:) integer, pointer :: elementMask(:), ElemMask(:) real(ESMF_KIND_R8), pointer :: elementArea(:), ElemArea(:) integer, allocatable :: LocalElmTable(:) integer :: sndBuf(1) type(ESMF_VM) :: vm type(ESMF_Mesh) :: Mesh integer(ESMF_KIND_I4) :: localSplitElems(1) integer(ESMF_KIND_I4) :: globalSplitElems(1) logical :: existSplitElems integer :: numPoly #if 0 integer, parameter :: maxNumPoly=20 real(ESMF_KIND_R8) :: polyCoords(3*maxNumPoly) real(ESMF_KIND_R8) :: polyDblBuf(3*maxNumPoly) real(ESMF_KIND_R8) :: area(maxNumPoly) integer :: polyIntBuf(maxNumPoly) integer :: triInd(3*(maxNumPoly-2)) #else integer :: maxNumPoly real(ESMF_KIND_R8),allocatable :: polyCoords(:) real(ESMF_KIND_R8),allocatable :: polyDblBuf(:) real(ESMF_KIND_R8),allocatable :: area(:) integer,allocatable :: polyIntBuf(:) integer,allocatable :: triInd(:) #endif real(ESMF_KIND_R8) :: totalarea integer :: spatialDim integer :: parametricDim integer :: lni,ti,tk type(ESMF_FileFormat_Flag) :: fileformatlocal integer :: coordDim logical :: convertToDeg logical :: haveNodeMask, haveElmtMask logical :: haveMask logical :: localAddUserArea type(ESMF_MeshLoc) :: localAddMask real(ESMF_KIND_R8), pointer :: varbuffer(:) real(ESMF_KIND_R8) :: missingvalue integer :: cartSpatialDim ! sp. dim of grid when converted to type(ESMF_CoordSys_Flag) :: coordSys ! additional variables used to parallelize node IO integer, pointer :: segmentTbl(:), pairoffsets(:) integer, pointer :: nodepairs(:), newpairs(:), mypair(:), allpairs(:) integer, pointer :: seqIndexList(:) integer, pointer :: haloIndexList(:) integer :: totalpairs, startind, endind integer :: localnodecnt, totalnodecnt, halonodecnt integer :: haloNodes, startNode type(ESMF_DistGrid) :: regDistGrid, nodeDistGrid type(ESMF_Array) :: regCoordArray, nodeCoordArray real(ESMF_KIND_R8), pointer :: fptr(:,:) type(ESMF_RouteHandle) :: redistHdl, haloHandle ! Initialize return code; assume failure until success is certain localrc = ESMF_RC_NOT_IMPL if (present(rc)) rc = ESMF_RC_NOT_IMPL if (present(addUserArea)) then localAddUserArea = addUserArea else localAddUserArea = .false. endif if (present(maskFlag)) then localAddMask = maskFlag else localAddMask = ESMF_MESHLOC_NONE endif ! Read the mesh definition from the file if (present(fileformat)) then fileformatlocal = fileformat else fileformatlocal = ESMF_FILEFORMAT_ESMFMESH endif if (fileformatlocal == ESMF_FILEFORMAT_UGRID) then if (.not. present(meshname)) then call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & msg="- meshname argument is missing", & ESMF_CONTEXT, rcToReturn=rc) endif 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 ! Default coordinate system coordSys = ESMF_COORDSYS_SPH_DEG if (fileformatlocal == ESMF_FILEFORMAT_ESMFMESH) then ! Get coordDim call ESMF_EsmfInq(filename,coordDim=coordDim, haveNodeMask=haveNodeMask, & haveElmtMask=haveElmtMask, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Don't convert if not 2D because that'll be cartesian right now if (coordDim .eq. 2) then convertToDeg = .true. else convertToDeg = .false. endif ! Get information from file if (haveNodeMask) then call ESMF_EsmfGetNode(filename, nodeCoords, nodeMask=glbNodeMask,& convertToDeg=convertToDeg, coordSys=coordSys, rc=localrc) else call ESMF_EsmfGetNode(filename, nodeCoords, & convertToDeg=convertToDeg, coordSys=coordSys, rc=localrc) endif if (haveElmtMask) then if (localAddUserArea) then call ESMF_EsmfGetElement(filename, elementConn, elmtNum, & startElmt, elementMask=elementMask, elementArea=elementArea, & rc=localrc) else call ESMF_EsmfGetElement(filename, elementConn, elmtNum, & startElmt, elementMask=elementMask, & rc=localrc) endif else if (localAddUserArea) then call ESMF_EsmfGetElement(filename, elementConn, elmtNum, & startElmt, elementArea=elementArea, & rc=localrc) else call ESMF_EsmfGetElement(filename, elementConn, elmtNum, & startElmt, rc=localrc) endif endif if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return elseif (fileformatlocal == ESMF_FILEFORMAT_UGRID) then haveElmtMask = .false. haveNodeMask = .false. if (localAddMask == ESMF_MESHLOC_ELEMENT) then haveElmtMask = .true. elseif (localAddMask == ESMF_MESHLOC_NODE) then haveNodeMask = .true. endif ! Get information from file call ESMF_GetElemFromUGridFile(filename, meshname, elementConn, & elmtNum, startElmt, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Chenk if the grid is 3D or 2D call ESMF_UGridInq(filename, meshname, nodeCount=nodeCnt, & nodeCoordDim=coordDim, rc=localrc) if (coordDim == 2 .and. localAddMask == ESMF_MESHLOC_ELEMENT) then !Get the variable and the missing value attribute from file ! Total number of local elements ElemCnt = ubound (elementConn, 2) allocate(varbuffer(ElemCnt)) call ESMF_UGridGetVarByName(filename, varname, varbuffer, startind=startElmt, & count=ElemCnt, location="face", & missingvalue=missingvalue, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Create local mask allocate(elementMask(ElemCnt)) elementMask(:)=1 do i=1,ElemCnt if (varbuffer(i) == missingvalue) elementMask(i)=0 enddo deallocate(varbuffer) elseif (coordDim == 2 .and. localAddMask == ESMF_MESHLOC_NODE) then !Get the variable and the missing value attribute from file ! Total number of total nodes allocate(varbuffer(nodeCnt)) call ESMF_UGridGetVarByName(filename, varname, varbuffer, & location="node", & missingvalue=missingvalue, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Create local mask allocate(glbNodeMask(nodeCnt)) glbNodeMask(:)=1 do i=1,nodeCnt if (varbuffer(i) == missingvalue) glbNodeMask(i)=0 enddo deallocate(varbuffer) endif else call ESMF_LogSetError(ESMF_RC_ARG_WRONG, & msg="- unrecognized fileformat", & ESMF_CONTEXT, rcToReturn=rc) return endif ! Figure out dimensions if (coordDim .eq. 2) then parametricDim=2 spatialDim = 2 if (coordSys == ESMF_COORDSYS_CART) then cartSpatialDim = 2 else cartSpatialDim=3 ! Assuming that this is spherical endif else if (coordDim .eq. 3) then parametricDim=3 spatialDim=3 cartSpatialDim=3 coordSys = ESMF_COORDSYS_CART else call ESMF_LogSetError(ESMF_RC_VAL_OUTOFRANGE, & msg="- only coordDim 2 or 3 is supported right now", & ESMF_CONTEXT, rcToReturn=rc) return endif if (parametricDim == 2) then Mesh = ESMF_MeshCreate3part (parametricDim, spatialDim, & coordSys=coordSys,rc=localrc) else Mesh = ESMF_MeshCreate3part (parametricDim, spatialDim, & coordSys=coordSys,rc=localrc) endif if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! These two arrays are temp arrays ! NodeUsed() used for multiple purposes, first, find the owners of the node ! later, used to store the local Node ID to be used in the ElmtConn table allocate (NodeUsed(NodeCnt)) ! Set to a number > PetCnt because it will store the PetNo if this node is used by ! the local elements and we will do a global reduce to find the minimal values NodeUsed(:)=PetCnt+100 ! Total number of local elements ElemCnt = ubound (elementConn, 2) ! Set the coorsponding NodeUsed(:) value to my PetNo if it is used by the local element ! Also calculate the total number of mesh elements based on elmtNum ! if elmtNum == 3 or 4, no change, if elmtNum > 4, break it into elmtNum-2 triangles totalElements = ElemCnt totalConnects = 0 maxNumPoly=0 if (parametricDim .eq. 2) then do ElemNo =1, ElemCnt do i=1,elmtNum(ElemNo) NodeUsed(elementConn(i,ElemNo))=PetNo enddo if (elmtNum(ElemNo) > 4) TotalElements = TotalElements + (elmtNum(ElemNo)-3) if (elmtNum(ElemNo) <= 4) then TotalConnects = TotalConnects+elmtNum(ElemNo) else TotalConnects = TotalConnects+3*(elmtNum(ElemNo)-2) end if if (elmtNum(ElemNo) > maxNumPoly) then maxNumPoly=elmtNum(ElemNo) endif end do else ! If not parametricDim==2, assuming parmetricDim==3 do ElemNo =1, ElemCnt do i=1,elmtNum(ElemNo) NodeUsed(elementConn(i,ElemNo))=PetNo enddo TotalConnects = TotalConnects+elmtNum(ElemNo) end do endif ! write(*,*) "maxNumPoly=",maxNumPoly ! create sparse matrix for localNode totalpairs = 200 allocate(mypair(1), nodepairs(totalpairs)) mypair(1) = 0 i=1 j=1 totalnodecnt=0 do while (i <= NodeCnt) do while (NodeUsed(i)>PetNo) i=i+1 end do if (i > NodeCnt) EXIT nodepairs(j)=i do while (NodeUsed(i)==PetNo) i=i+1 totalnodecnt = totalnodecnt+1 end do nodepairs(j+1)=i-1 j=j+2 mypair(1)=mypair(1)+1 if (j>totalpairs) then !print *, 'reallocate nodepairs' allocate(newpairs(totalpairs*2)) newpairs(1:totalpairs)=nodepairs deallocate(nodepairs) nodepairs => newpairs totalpairs=totalpairs*2 endif enddo ! collect the node segment pairs in all the PETs allocate(allpairs(PetCnt)) call ESMF_VMAllGather(vm, mypair, allpairs, 1, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return allocate(pairoffsets(PetCnt)) pairoffsets(1)=0 allpairs = allpairs*2 totalpairs = allpairs(1) do i=2,PetCnt pairoffsets(i)=pairoffsets(i-1)+allpairs(i-1) totalpairs = totalpairs+allpairs(i) enddo !print *, PetNo, " Total node pairs and total nodes: ", mypair(1), totalpairs, totalnodecnt allocate(segmentTbl(totalpairs)) call ESMF_VMAllGatherV(vm, nodepairs, mypair(1)*2, segmentTbl, allpairs, & pairoffsets, rc=localrc) !print *, 'pairoffsets ', pairoffsets !print *, PetNo, 'segmentTbl ', segmentTbl(pairoffsets(PetNo+1)+1:pairoffsets(PetNo+1)+100) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Need to decide who owns the local nodes ! Assign the node to the first PET that uses it, so only need to ! search the pairs from PET=0:PetNo-1 halonodecnt = 0 do j=1, mypair(1) startind=nodepairs((j-1)*2+1) endind = nodepairs((j-1)*2+2) !print *, PetNo, "nodepairs: ", j, startind, endind do k=startind, endind do i=1, PetNo do n = pairoffsets(i)+1, pairoffsets(i+1),2 if (k < segmentTbl(n)) EXIT if (k > segmentTbl(n+1)) CYCLE NodeUsed(k)= i-1 halonodecnt = halonodecnt+1 !print *, PetNo, k, 'fall within ', segmentTbl(n), segmentTbl(n+1) goto 100 enddo enddo 100 continue enddo enddo deallocate(pairoffsets, segmentTbl, allpairs, mypair, nodepairs) !print *, PetNo, "total local nodes and halo nodes counts:", totalnodecnt, halonodecnt ! Create a distgrid based on the local ownership of the node ids allocate(seqIndexList(totalnodecnt-halonodecnt)) allocate(haloIndexList(halonodecnt)) ! count number of nodes used and convert NodeUsed values into local index localNodes = 0 haloNodes = 0 do NodeNo = 1, NodeCnt if (NodeUsed(NodeNo) == PetNo) then localNodes = localNodes+1 seqIndexList(localNodes)=NodeNo elseif (NodeUsed(NodeNo) < PetNo) then haloNodes = haloNodes+1 haloIndexList(haloNodes)=NodeNo endif enddo nodeDistGrid = ESMF_DistGridCreate(arbSeqIndexList=seqIndexList, rc=localrc) nodeCoordArray= ESMF_ArrayCreate(nodeDistGrid, ESMF_TYPEKIND_R8, & distgridToArrayMap=(/2/), & haloSeqIndexList=haloIndexList, undistLBound=(/1/), & undistUBound=(/coordDim/),rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Read in the node coordinates in parallel and redistribute it based on the arb. distgrid localnodecnt=NodeCnt/PetCnt startNode=localnodecnt*PetNo+1 if (PetNo == PetCnt-1) then localnodecnt = localnodecnt + mod(NodeCnt, PetCnt) endif call ESMF_GetNodeFromUGridFile(filename, meshname, nodeCoords, & nodeCount=localnodecnt, startNode=startNode, & convertToDeg = .true., rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Create a distgrid with regular distribution for the NodeCoords regDistGrid = ESMF_DistGridCreate((/1/), (/NodeCnt/), & regDecomp=(/PetCnt/), & decompflag=(/ESMF_DECOMP_RESTLAST/), & indexflag=ESMF_INDEX_GLOBAL, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Create an array with one undistributed dimension for the coordinates regCoordArray= ESMF_ArrayCreate(regDistGrid, ESMF_TYPEKIND_R8, & distgridToArrayMap=(/2/), & undistLBound=(/1/), undistUBound=(/coordDim/),rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Set array values call ESMF_ArrayGet(regCoordArray, localDe=0, farrayPtr=fptr, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! NodeCoords(coordDim, localnodecnt), fptr(coordDim, startNode:startNode+localnodecnt) ! can we do the following array assignment? ! print *, 'bounds of fptr: ', lbound(fptr), ubound(fptr) fptr(:,:) = NodeCoords(:,:) deallocate(NodeCoords) ! call array redist to redist to the new distribution call ESMF_ArrayRedistStore(regCoordArray, nodeCoordArray, routehandle=redistHdl, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_ArrayRedist(regCoordArray, nodeCoordArray, routehandle=redistHdl, & rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Need to get the data for the Halo region call ESMF_ArrayHaloStore(nodeCoordArray, haloHandle, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_ArrayHalo(nodeCoordArray, haloHandle, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Release RouteHandle, Array, and DistGrid call ESMF_ArrayHaloRelease(haloHandle, noGarbage=.true., rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_ArrayRedistRelease(redistHdl, noGarbage=.true., rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_ArrayDestroy(regCoordArray, noGarbage=.true., rc=localrc)) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_DistGridDestroy(regDistGrid, noGarbage=.true., rc=localrc)) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Now, get the node coordinates fortran pointer, this fptr includes both the ! exclusive region and the halo region call ESMF_ArrayGet(nodeCoordArray, farrayPtr=nodeCoords, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return !print *, 'NodeCoords ', nodeCoords(1,1000), nodeCoords(2,1000) ! allocate nodes arrays for ESMF_MeshAddNodes() allocate (NodeId(totalnodecnt)) allocate (NodeOwners(totalnodecnt)) localnodecnt=totalnodecnt-halonodecnt NodeId(1:localnodecnt)=seqIndexList NodeId(localnodecnt+1:totalnodecnt)=haloIndexList NodeOwners(1:localnodecnt)=PetNo ! Now change NodeUsed content to store the local node index to be used by elemConn do i = 1, localnodecnt NodeUsed(seqIndexList(i))=i enddo do i = 1, halonodecnt NodeOwners(localnodecnt+i) = NodeUsed(haloIndexList(i)) NodeUsed(haloIndexList(i))=localnodecnt+i enddo deallocate(seqIndexList, haloIndexList) if (parametricDim .eq. 2) then allocate (NodeCoords1D(totalnodecnt*CoordDim)) else ! If not parametricDim==2, assuming parmetricDim==3 allocate(NodeCoords1D(totalnodecnt*3)) endif i = 1 total = 0 if (parametricDim .eq. 2) then do i = 1, totalnodecnt do dim = 1, CoordDim NodeCoords1D ((i-1)*CoordDim+dim) = nodeCoords (dim, i) end do end do else ! If not parametricDim==2, assuming parmetricDim==3 do NodeNo = 1, totalnodecnt do dim = 1, 3 NodeCoords1D ((i-1)*3+dim) = nodeCoords(dim, NodeNo) end do end do endif ! Add nodes if (.not. haveNodeMask) then ! Add nodes call ESMF_MeshAddNodes (Mesh, NodeIds=NodeId, & NodeCoords=NodeCoords1D, & NodeOwners=NodeOwners, & rc=localrc) else allocate(NodeMask(localNodes)) do i=1,localNodes NodeMask(i)=glbNodeMask(NodeId(i)) enddo call ESMF_MeshAddNodes (Mesh, NodeIds=NodeId, & NodeCoords=NodeCoords1D, & NodeOwners=NodeOwners, & NodeMask = NodeMask, & rc=localrc) deallocate(NodeMask) deallocate(glbNodeMask) endif if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_ArrayDestroy(nodeCoordArray, noGarbage=.true., rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return call ESMF_DistGridDestroy(nodeDistGrid, noGarbage=.true., rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Need to calculate the total number of ESMF_MESH objects and the start element ID ! Do a global gather to get all the local TotalElements allocate(localElmTable(PetCnt)) sndBuf(1)=TotalElements call ESMF_VMAllGather(vm, sndBuf, localElmTable, 1, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! Find out the start element ID myStartElmt=0 do i=1,PetNo myStartElmt = myStartElmt+localElmTable(i) end do deallocate(localElmTable) ! allocate element arrays for the local elements allocate (ElemId(TotalElements)) allocate (ElemType(TotalElements)) allocate (ElemConn(TotalConnects)) if (localAddUserArea) allocate(ElemArea(TotalElements)) ! Allocate mask if the user wants one haveMask=.false. if (haveElmtMask) then allocate (ElemMask(TotalElements)) haveMask=.true. endif ! figure out if there are split elements globally !! Fake logical allreduce .or. with MAX if (totalElements .gt. ElemCnt) then localSplitElems(1)=1 else localSplitElems(1)=0 endif call ESMF_VMAllReduce(vm, localSplitElems, globalSplitElems, 1, ESMF_REDUCE_MAX, rc=localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return if (globalSplitElems(1) .eq. 1) then existSplitElems=.true. else existSplitElems=.false. endif ! Set split element info if (existSplitElems) then Mesh%hasSplitElem=.true. allocate(mesh%splitElemMap(TotalElements)) Mesh%splitElemStart=myStartElmt+1 ! position of first element Mesh%splitElemCount=TotalElements Mesh%origElemStart=startElmt ! position of first element Mesh%origElemCount=ElemCnt endif ! Allocate a mask even if the user doesn't want one, if we have split elements if (existSplitElems .and. .not. haveElmtMask) then allocate (ElemMask(TotalElements)) haveMask=.true. ElemMask(:)=1 ! default to nothing masked out endif ! The ElemId is the global ID. The myStartElmt is the starting Element ID(-1), and the ! element IDs will be from startElmt to startElmt+ElemCnt-1 ! The ElemConn() contains the four corner node IDs for each element and it is organized ! as a 1D array. The node IDs are "local", which are stored in NodeUsed(:) ElemNo = 1 ConnNo = 0 if (parametricDim .eq. 2) then ! Allocate variables for triangulation allocate(polyCoords(3*maxNumPoly)) allocate(polyDblBuf(3*maxNumPoly)) allocate(area(maxNumPoly)) allocate(polyIntBuf(maxNumPoly)) allocate(triInd(3*(maxNumPoly-2))) ! Parametric dim=2 and cartSpatialDim=3 ! Means spherical, so calc. cart. coordinates if (cartSpatialDim .eq. 3) then allocate(NodeCoordsCart(cartSpatialDim*localNodes)) ti=0 tk=0 do i=1,localNodes call c_esmc_sphdeg_to_cart(NodeCoords1D(ti+1), & NodeCoords1D(ti+2), & NodeCoordsCart(tk+1), & NodeCoordsCart(tk+2), & NodeCoordsCart(tk+3), & localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ti=ti+2 tk=tk+3 enddo endif ! Loop through creating Mesh appropriate elements do j = 1, ElemCnt if (elmtNum(j)==3) then ElemId(ElemNo) = myStartElmt+ElemNo ElemType (ElemNo) = ESMF_MESHELEMTYPE_TRI do i=1,3 ElemConn (ConnNo+i) = NodeUsed(elementConn(i,j)) end do if (existSplitElems) Mesh%splitElemMap(ElemNo)=j+startElmt-1 if (haveElmtMask) ElemMask(ElemNo) = elementMask(j) if (localAddUserArea) ElemArea(ElemNo) = elementArea(j) ElemNo=ElemNo+1 ConnNo=ConnNo+3 elseif (elmtNum(j)==4) then ElemId(ElemNo) = myStartElmt+ElemNo ElemType (ElemNo) = ESMF_MESHELEMTYPE_QUAD do i=1,4 ElemConn (ConnNo+i) = NodeUsed(elementConn(i,j)) end do if (existSplitElems) Mesh%splitElemMap(ElemNo)=j+startElmt-1 if (haveElmtMask) ElemMask(ElemNo) = elementMask(j) if (localAddUserArea) ElemArea(ElemNo) = elementArea(j) ElemNo=ElemNo+1 ConnNo=ConnNo+4 else ! number of points in poly to triangulate numPoly=elmtNum(j) if (numPoly > maxNumPoly) then call ESMF_LogSetError(ESMF_RC_ARG_BAD, & msg="- File contains polygons with more sides than triangulation is supported for", & ESMF_CONTEXT, rcToReturn=rc) return endif ! Copy points into input list if (cartSpatialDim==2) then ti=0 do k=1,numPoly lni=2*(NodeUsed(elementConn(k,j))-1) ! get the index of the node coords in the local list polyCoords(ti+1)=NodeCoords1D(lni+1) polyCoords(ti+2)=NodeCoords1D(lni+2) ti=ti+2 enddo else if (cartSpatialDim==3) then ti=0 do k=1,numPoly lni=3*(NodeUsed(elementConn(k,j))-1) ! get the index of the node coords in the local list polyCoords(ti+1)=NodeCoordsCart(lni+1) polyCoords(ti+2)=NodeCoordsCart(lni+2) polyCoords(ti+3)=NodeCoordsCart(lni+3) ti=ti+3 enddo endif ! Checking for other spatialDims above, not here in a loop ! call triangulation routine call c_ESMC_triangulate(parametricDim, cartSpatialDim, & numPoly, polyCoords, polyDblBuf, polyIntBuf, & triInd, localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! translate triangulation out of output list ti=0 startElemNo = ElemNo do k=1,numPoly-2 ElemId(ElemNo)=myStartElmt+ElemNo ElemType (ElemNo) = ESMF_MESHELEMTYPE_TRI ElemConn (ConnNo+1) = NodeUsed(elementConn(triInd(ti+1)+1,j)) ElemConn (ConnNo+2) = NodeUsed(elementConn(triInd(ti+2)+1,j)) ElemConn (ConnNo+3) = NodeUsed(elementConn(triInd(ti+3)+1,j)) if (existSplitElems) Mesh%splitElemMap(ElemNo)=j+startElmt-1 if (haveElmtMask) ElemMask(ElemNo) = elementMask(j) ! Calculate area of sub-triangle !if (localAddUserArea) then if (cartSpatialDim==2) then tk=0 do i=1,3 lni=2*(ElemConn(ConnNo+i)-1) ! get the index of the node coords in the local list polyCoords(tk+1)=NodeCoords1D(lni+1) polyCoords(tk+2)=NodeCoords1D(lni+2) tk=tk+2 enddo else if (cartSpatialDim==3) then tk=0 do i=1,3 lni=3*(ElemConn(ConnNo+i)-1) ! get the index of the node coords in the local list polyCoords(tk+1)=NodeCoordsCart(lni+1) polyCoords(tk+2)=NodeCoordsCart(lni+2) polyCoords(tk+3)=NodeCoordsCart(lni+3) tk=tk+3 enddo endif nEdges = 3 call c_ESMC_get_polygon_area(cartSpatialDim, nEdges, polyCoords, area(k), localrc) if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! endif ! If the area of the subtriangle is 0.0 mask it out if (area(k)==0.0) then ElemMask(ElemNo)=0 endif ElemNo=ElemNo+1 ConnNo=ConnNo+3 ti=ti+3 enddo !!! set the area for each splitted triangle if (localAddUserArea) then totalarea = 0 do k=1,numPoly-2 totalarea = totalarea + area(k) enddo do k=1, numPoly-2 elemArea(startElemNo+k) = elementArea(j)*(area(k)/totalarea) enddo endif end if end do ! deallocate cart nodes if (cartSpatialDim .eq. 3) then deallocate(NodeCoordsCart) endif ! deallocate after triangulation deallocate(polyCoords) deallocate(polyDblBuf) deallocate(area) deallocate(polyIntBuf) deallocate(triInd) else ! If not parametricDim==2, assuming parmetricDim==3 do j = 1, ElemCnt if (elmtNum(j)==4) then ElemType (ElemNo) = ESMF_MESHELEMTYPE_TETRA elseif (elmtNum(j)==8) then ElemType (ElemNo) = ESMF_MESHELEMTYPE_HEX else call ESMF_LogSetError(ESMF_RC_VAL_OUTOFRANGE, & msg="- in 3D currently only support Tetra. (4 nodes) or Hexa. (8 nodes)", & ESMF_CONTEXT, rcToReturn=rc) return endif do i=1,elmtNum(j) ElemConn (ConnNo+i) = NodeUsed(elementConn(i,j)) end do ElemId(ElemNo) = myStartElmt+ElemNo if (haveElmtMask) ElemMask(ElemNo) = elementMask(j) if (localAddUserArea) ElemArea(ElemNo) = elementArea(j) ElemNo=ElemNo+1 ConnNo=ConnNo+elmtNum(j) end do endif if (ElemNo /= TotalElements+1) then write (ESMF_UtilIOStdout,*) & PetNo, ' TotalElements does not match ',ElemNo-1, TotalElements end if ! Add elements if (haveMask .and. localAddUserArea) then call ESMF_MeshAddElements (Mesh, ElemId, ElemType, ElemConn, & elementMask=ElemMask, elementArea=ElemArea, rc=localrc) elseif (haveMask) then call ESMF_MeshAddElements (Mesh, ElemId, ElemType, ElemConn, & elementMask=ElemMask, rc=localrc) elseif (localAddUserArea) then call ESMF_MeshAddElements (Mesh, ElemId, ElemType, ElemConn, & elementArea=ElemArea, rc=localrc) else call ESMF_MeshAddElements (Mesh, ElemId, ElemType, ElemConn, rc=localrc) end if if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, & ESMF_CONTEXT, rcToReturn=rc)) return ! NEED TO SET THIS HERE, BECAUSE MEshAddElements sets it to false if (existSplitElems) then Mesh%hasSplitElem=.true. else Mesh%hasSplitElem=.false. endif deallocate(NodeUsed, NodeId, NodeCoords1D, NodeOwners) deallocate(ElemId, ElemType, ElemConn) deallocate(elementConn, elmtNum) if (haveElmtMask) deallocate(elementMask) if (haveMask) deallocate(ElemMask) if (localAddUserArea) deallocate(elementArea, ElemArea) ESMF_MeshCreateFromUnstruct = Mesh if (present(rc)) rc=ESMF_SUCCESS return end function ESMF_MeshCreateFromUnstruct !------------------------------------------------------------------------------ #endif end module ESMF_MeshMod